| Class | Ellip_Slv |
| In: |
ellip_slv.f90
|
代数演算を用いて楕円型偏微分方程式を解くモジュール
| Subroutine : | |||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| rho(size(x),size(y)) : | real, intent(in)
| ||
| eps : | real, intent(in)
| ||
| boundary : | character(4), intent(in)
| ||
| psi(size(x),size(y)) : | real, intent(inout)
| ||
| bound_opt(size(x),size(y)) : | real, intent(in), optional
| ||
| a(size(x),size(y)) : | real, intent(in), optional
| ||
| b(size(x),size(y)) : | real, intent(in), optional
| ||
| c(size(x),size(y)) : | real, intent(in), optional
| ||
| d(size(x),size(y)) : | real, intent(in), optional
| ||
| e(size(x),size(y)) : | real, intent(in), optional
| ||
| f(size(x),size(y)) : | real, intent(in), optional
| ||
| undef : | real, intent(in), optional
| ||
| inner_bound(size(x),size(y)) : | integer, intent(in), optional
| ||
| init_flag : | logical, intent(in), optional
| ||
| accel : | real, intent(in), optional
|
ガウス=ザイデル法による楕円型方程式の求積 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される. $$a\dfrac{partial ^2\psi}{partial x^2} +b\dfrac{partial ^2\psi}{partial x\partial y} +c\dfrac{partial ^2\psi}{partial y^2} +d\dfrac{partial psi}{partial x} +e\dfrac{partial psi}{partial y} +f\psi =rho $$ の各係数に対応している.
subroutine Ellip_GauSei_2d( x, y, rho, eps, boundary, psi, bound_opt, a, b, c, d, e, f, undef, inner_bound, init_flag, accel )
! ガウス=ザイデル法による楕円型方程式の求積
! 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される.
! $$a\dfrac{\partial ^2\psi}{\partial x^2} +b\dfrac{\partial ^2\psi}{\partial x\partial y} +c\dfrac{\partial ^2\psi}{\partial y^2} +d\dfrac{\partial \psi}{\partial x} +e\dfrac{\partial \psi}{\partial y} +f\psi =\rho $$
! の各係数に対応している.
implicit none
real, intent(in) :: x(:) ! 領域の横座標
real, intent(in) :: y(:) ! 領域の縦座標
real, intent(in) :: rho(size(x),size(y)) ! ポアソン方程式の強制項
! rho =0 でラプラス方程式も求積可能
real, intent(in) :: eps ! 収束条件
character(4), intent(in) :: boundary ! 境界条件
! 4 文字で各辺の境界条件を与える.
! 1 文字目 : x 下端, 2 文字目 : y 左端, 3 文字目 : x 上端,
! 4 文字目 : y 右端
! boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
real, intent(in), optional :: bound_opt(size(x),size(y)) ! 境界での強制
! ノイマン境界の場合 : フラックス値
real, intent(in), optional :: a(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: b(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: c(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: d(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: e(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: f(size(x),size(y)) ! 各微分項の係数
real, intent(inout) :: psi(size(x),size(y)) ! ポアソン方程式の解
real, intent(in), optional :: undef ! 未定義値
integer, intent(in), optional :: inner_bound(size(x),size(y))
! 内部領域の境界. 値に応じてその格子点で境界値計算
! 1 = 固定端境界, 10 = 境界の内側.
! 2 = y 方向自由端境界 (フラックスは上向き)
! -2 = y 方向自由端境界 (フラックスは下向き)
! 4 = x 方向自由端境界 (フラックスは右向き)
! -4 = x 方向自由端境界 (フラックスは左向き)
! 3 = 周期境界
! 8 = |_, ~| で両方とも自由境界条件
! -8 = |~, _| で両方とも自由境界条件
! この引数が与えられなければ全領域を計算する.
! 境界の内側格子点 (10) は反復計算を行わず,
! undef で設定された値もしくはゼロが入る.
! このときの境界値は bound_opt の値が用いられる.
logical, intent(in), optional :: init_flag ! psi の値をゼロで初期化するか.
! .true. = 初期化する. .false. = 初期化しない.
! デフォルトでは初期化する.
real, intent(in), optional :: accel ! SOR の加速係数 (0 < accel < 2)
! デフォルト = 1
integer :: i, j, ix, jy
integer :: nx ! x 方向の配列要素
integer :: ny ! y 方向の配列要素
integer :: signb ! 各係数を計算するかどうか
integer, dimension(size(x),size(y)) :: ib
real :: defun
real :: tmp, err, err_max
real :: tmp_b, accc
real :: bnd(size(x),size(y))
real :: dx(size(x)), dy(size(y)), dx2(size(x)), dy2(size(y))
real, dimension(size(x),size(y)) :: dxdy
real, dimension(size(x),size(y)) :: at, bt, ct, dt, et, ft
real, dimension(size(x),size(y)) :: adp, adm, cep, cem, ac, divi
character(4) :: bound
logical :: sor_flag
logical, dimension(size(x),size(y)) :: inner_flag
bound(1:4)=boundary(1:4)
nx=size(x)
ny=size(y)
!-- 応答関数の初期化
if(present(init_flag))then
if(init_flag.eqv..true.)then
psi = 0.0
end if
else
psi = 0.0
end if
!-- 内部境界の判別フラグの設定
if(present(inner_bound))then
call set_bound( bound, ib, inner_flag, inner_bound )
else
call set_bound( bound, ib, inner_flag )
end if
!-- 領域・内部境界における境界値の設定
if(present(bound_opt))then
call setval_bound( ib, bnd, psi, bound_opt )
else
call setval_bound( ib, bnd, psi )
end if
!-- 未定義値の設定
if(present(undef))then
defun=undef
else
defun=0.0
end if
!-- 係数の代入
!-- a, c については, 値が入れられていなければ, 全配列に 1 を代入する.
if(present(a))then
call set_coe( at, ext=a )
else
call set_coe( at, def=1.0 )
end if
if(present(c))then
call set_coe( ct, ext=c )
else
call set_coe( ct, def=1.0 )
end if
if(present(b))then
call set_coe( bt, ext=b )
signb=1
else
call set_coe( bt, def=0.0 )
signb=0
end if
if(present(d))then
call set_coe( dt, ext=d )
else
call set_coe( dt, def=0.0 )
end if
if(present(e))then
call set_coe( et, ext=e )
else
call set_coe( et, def=0.0 )
end if
if(present(f))then
call set_coe( ft, ext=f )
else
call set_coe( ft, def=0.0 )
end if
!-- 最高階数における係数チェック. (係数がゼロでないか調べる.)
call check_coe( at, 0.0 )
call check_coe( ct, 0.0 )
!-- 加速係数の判定
if(present(accel))then
accc=accel
sor_flag=.true.
else
sor_flag=.false.
end if
!-- 以下で先に格子間隔等の 1 回計算でよいものを求めておく.
!-- これらは 1 方向のみで変化すればよい.
!-- 格子点間隔の計算
do i=2,nx-1
dx(i)=(x(i+1)-x(i-1))*0.5
dx2(i)=dx(i)**2
end do
do j=2,ny-1
dy(j)=(y(j+1)-y(j-1))*0.5
dy2(j)=dy(j)**2
end do
dx(1)=(x(2)-x(1))
dx(nx)=(x(nx)-x(nx-1))
dy(1)=(y(2)-y(1))
dy(ny)=(y(ny)-y(ny-1))
do j=1,ny
do i=1,nx
dxdy(i,j)=dx(i)*dy(j)
end do
end do
!-- ポアソン係数の計算
!-- 実際にポアソン係数が使用されるのは, 境界を除いた 1 回り内側なので,
!-- 計算量削減のため, ループをそのようにしておく.
ac=0.0
adp=0.0
adm=0.0
cep=0.0
cem=0.0
bt=0.0
!-- 最高次数係数 ac の計算
!$omp parallel default(shared)
!$omp do schedule(dynamic) private(i,j)
do j=2,ny-1
do i=2,nx-1
ac(i,j)=1.0/(2.0*(at(i,j)/dx2(i)+ct(i,j)/dy2(j))-ft(i,j))
adp(i,j)=(at(i,j)/(dx2(i))+0.5*dt(i,j)/dx(i))*ac(i,j)
adm(i,j)=(at(i,j)/(dx2(i))-0.5*dt(i,j)/dx(i))*ac(i,j)
cep(i,j)=(ct(i,j)/(dy2(j))+0.5*et(i,j)/dy(j))*ac(i,j)
cem(i,j)=(ct(i,j)/(dy2(j))-0.5*et(i,j)/dy(j))*ac(i,j)
bt(i,j)=0.25*bt(i,j)/(dxdy(i,j))*ac(i,j)
end do
end do
!$omp end do
!$omp end parallel
err_max=eps ! while に入るための便宜的措置
!-- 実際のソルバ ---
do while(err_max>=eps)
err_max=0.0
do j=1,ny
do i=1,nx
!-- 以降, 反復計算に必要な点の周囲 8 点についてそれぞれ
!-- inner_flag のチェックと同時に適切な値をそれぞれ逐次計算する,
!-- 下で, 各方向の格子計算を行っているが, ib=8,-8 は 4 隅格子のときにしか
!-- case select しない. なぜなら, 真横や上下に隅格子がくることはありえない.
if(inner_flag(i,j).eqv..false.)then ! .false. なら領域計算開始
tmp=-rho(i,j)*ac(i,j)
tmp=tmp+adp(i,j)*psi(i+1,j) +adm(i,j)*psi(i-1,j) +cep(i,j)*psi(i,j+1) +cem(i,j)*psi(i,j-1)
if(signb==0)then ! そもそも bt = 0 なら計算しない.
tmp_b=0.0
else
tmp_b=bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))
end if
tmp=tmp+tmp_b
else ! .true. なら境界計算に移行.
select case (ib(i,j))
case (1)
tmp=bnd(i,j)
case (2) ! x 方向にフラックス一定, 上側が参照値
tmp=psi(i+1,j)-bnd(i,j)*dx(i)
case (-2) ! x 方向にフラックス一定, 下側が参照値
tmp=psi(i-1,j)+bnd(i,j)*dx(i)
case (4) ! y 方向にフラックス一定, 右側が参照値
tmp=psi(i,j+1)-bnd(i,j)*dy(j)
case (-4) ! y 方向にフラックス一定, 左側が参照値
tmp=psi(i,j-1)+bnd(i,j)*dy(j)
case (3) ! 周期境界
if(i==1)then
ix=nx-1
else if(i==nx)then
ix=2
else
ix=i
end if
if(j==1)then
jy=ny-1
else if(j==ny)then
jy=2
else
jy=j
end if
tmp=psi(ix,jy)
case (7) ! 両方フラックス一定で内部境界限定.
if((ib(i+1,j+1)==10).and.(ib(i+1,j)/=10).and. (ib(i,j+1)/=10))then
tmp=0.5*(psi(i-1,j+1)+psi(i+1,j-1) +bnd(i,j+1)*dx(i)+bnd(i+1,j)*dy(j))
else if((ib(i-1,j-1)==10).and.(ib(i-1,j)/=10).and. (ib(i,j-1)/=10))then
tmp=0.5*(psi(i+1,j-1)+psi(i-1,j+1) -bnd(i,j-1)*dx(i)-bnd(i-1,j)*dy(j))
end if
case (-7) ! 両方フラックス一定で内部境界限定.
if((ib(i-1,j+1)==10).and.(ib(i-1,j)/=10).and. (ib(i,j+1)/=10))then
tmp=0.5*(psi(i+1,j+1)+psi(i-1,j-1) -bnd(i,j+1)*dx(i)+bnd(i-1,j)*dy(j))
else if((ib(i+1,j-1)==10).and.(ib(i+1,j)/=10).and. (ib(i,j-1)/=10))then
tmp=0.5*(psi(i-1,j-1)+psi(i+1,j+1) +bnd(i,j-1)*dx(i)-bnd(i+1,j)*dy(j))
end if
case (8) ! 両方フラックス一定で左下角か右上角, もしくは内部境界.
if(i==1.and.j==1)then ! -- 評価 1
tmp=psi(i+1,j+1)-0.5*(bnd(i+1,j)*dy(j)+bnd(i,j+1)*dx(i))
else if(i==nx.and.j==ny)then ! -- 評価 2
tmp=psi(i-1,j-1)+0.5*(bnd(i-1,j)*dy(j)+bnd(i,j-1)*dx(i))
else if(ib(i-1,j)==10.and.ib(i,j-1)==10)then
! -- 評価 1 と同じ
tmp=psi(i+1,j+1)-0.5*(bnd(i+1,j)*dy(j)+bnd(i,j+1)*dx(i))
else if(ib(i+1,j)==10.and.ib(i,j+1)==10)then
! -- 評価 2 と同じ
tmp=psi(i-1,j-1)+0.5*(bnd(i-1,j)*dy(j)+bnd(i,j-1)*dx(i))
end if
case (-8) ! 両方フラックス一定で右下角か左上角
if(i==1.and.j==ny)then ! -- 評価 1
tmp=psi(i+1,j-1)+0.5*(bnd(i+1,j)*dy(j)-bnd(i,j-1)*dx(i))
else if(i==nx.and.j==1)then ! -- 評価 2
tmp=psi(i-1,j+1)+0.5*(-bnd(i-1,j)*dy(j)+bnd(i,j+1)*dx(i))
else if(ib(i-1,j)==10.and.ib(i,j+1)==10)then
! -- 評価 1 と同じ
tmp=psi(i+1,j-1)+0.5*(bnd(i+1,j)*dy(j)-bnd(i,j-1)*dx(i))
else if(ib(i+1,j)==10.and.ib(i,j-1)==10)then
! -- 評価 2 と同じ
tmp=psi(i-1,j+1)+0.5*(-bnd(i-1,j)*dy(j)+bnd(i,j+1)*dx(i))
end if
end select
end if
if(sor_flag.eqv..true.)then
tmp=(1.0-accc)*psi(i,j)+tmp*accc
end if
err=abs(tmp-psi(i,j))
!-- 最大誤差の更新
if(err_max<=err)then
err_max=err
end if
psi(i,j)=tmp
end do
end do
end do
!-- 境界の設定
call calculate_bound( ib, dx, dy, bnd, psi )
!-- 未定義領域には undef を代入する.
do j=1,ny
do i=1,nx
if(ib(i,j)==10)then
psi(i,j)=defun
end if
end do
end do
end subroutine Ellip_GauSei_2d
| Subroutine : | |||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| z(:) : | real, intent(in)
| ||
| rho(size(x),size(y),size(z)) : | real, intent(in)
| ||
| eps : | real, intent(in)
| ||
| boundary : | character(6), intent(in)
| ||
| psi(size(x),size(y),size(z)) : | real, intent(inout)
| ||
| bound_opt(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| xa(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| ya(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| za(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| a(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| b(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| c(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| d(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| e(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| f(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| g(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| undef : | real, intent(in), optional
| ||
| inner_bound(size(x),size(y),size(z)) : | integer, intent(in), optional
| ||
| init_flag : | logical, intent(in), optional
| ||
| accel : | real, intent(in), optional
|
ガウス=ザイデル法による楕円型方程式の求積 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される. $$xa\dfrac{partial ^2\psi}{partial x^2} +ya\dfrac{partial ^2\psi}{partial y^2} +za\dfrac{partial ^2\psi}{partial z^2} +a\dfrac{partial ^2\psi}{partial x\partial y} +b\dfrac{partial ^2\psi}{partial y\partial z} +c\dfrac{partial ^2\psi}{partial z\partial x} +d\dfrac{partial psi}{partial x} +e\dfrac{partial psi}{partial y} +f\dfrac{partial psi}{partial z} +g\psi =rho $$ の各係数に対応している.
subroutine Ellip_GauSei_3d(x, y, z, rho, eps, boundary, psi, bound_opt, xa, ya, za, a, b, c, d, e, f, g, undef, inner_bound, init_flag, accel )
! ガウス=ザイデル法による楕円型方程式の求積
! 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される.
! $$xa\dfrac{\partial ^2\psi}{\partial x^2} +ya\dfrac{\partial ^2\psi}{\partial y^2} +za\dfrac{\partial ^2\psi}{\partial z^2} +a\dfrac{\partial ^2\psi}{\partial x\partial y} +b\dfrac{\partial ^2\psi}{\partial y\partial z} +c\dfrac{\partial ^2\psi}{\partial z\partial x} +d\dfrac{\partial \psi}{\partial x} +e\dfrac{\partial \psi}{\partial y} +f\dfrac{\partial \psi}{\partial z} +g\psi =\rho $$
! の各係数に対応している.
implicit none
real, intent(in) :: x(:) ! 領域の x 座標
real, intent(in) :: y(:) ! 領域の y 座標
real, intent(in) :: z(:) ! 領域の z 座標
real, intent(in) :: rho(size(x),size(y),size(z)) ! ポアソン方程式の強制項
! rho =0 でラプラス方程式も求積可能
real, intent(in) :: eps ! 収束条件
character(6), intent(in) :: boundary ! 境界条件
! 4 文字で各辺の境界条件を与える.
! 1 文字目 : x 下端, 2 文字目 : y 左端, 3 文字目 : x 上端,
! 4 文字目 : y 右端
! boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
real, intent(in), optional :: bound_opt(size(x),size(y),size(z))
! 境界での強制
! ノイマン境界の場合 : フラックス値
real, intent(in), optional :: xa(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: ya(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: za(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: a(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: b(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: c(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: d(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: e(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: f(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: g(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(inout) :: psi(size(x),size(y),size(z)) ! ポアソン方程式の解
real, intent(in), optional :: undef ! 未定義値
integer, intent(in), optional :: inner_bound(size(x),size(y),size(z))
! 内部領域の境界. 値に応じてその格子点で境界値計算
! 1 = 固定端境界, 10 = 境界の内側.
! 2 = y 方向自由端境界 (フラックスは上向き)
! -2 = y 方向自由端境界 (フラックスは下向き)
! 4 = x 方向自由端境界 (フラックスは右向き)
! -4 = x 方向自由端境界 (フラックスは左向き)
! 3 = 周期境界
! 8 = |_, ~| で両方とも自由境界条件
! -8 = |~, _| で両方とも自由境界条件
! この引数が与えられなければ全領域を計算する.
! 境界の内側格子点 (10) は反復計算を行わず,
! undef で設定された値もしくはゼロが入る.
! このときの境界値は bound_opt の値が用いられる.
logical, intent(in), optional :: init_flag ! psi の値をゼロで初期化するか.
! .true. = 初期化する. .false. = 初期化しない.
! デフォルトでは初期化する.
real, intent(in), optional :: accel ! SOR の加速係数 (0 < accel < 2)
! デフォルト = 1
integer :: i, j, k, ix, jy, kz
integer :: nx ! x 方向の配列要素
integer :: ny ! y 方向の配列要素
integer :: nz ! z 方向の配列要素
integer :: signa, signb, signc ! 各係数を計算するかどうか
integer, dimension(size(x),size(y),size(z)) :: ib
real :: defun
real :: tmp, err, err_max
real :: tmp_b, accc
real :: bnd(size(x),size(y),size(z))
real :: dx(size(x)), dy(size(y)), dx2(size(x)), dy2(size(y))
real :: dz(size(z)), dz2(size(z))
real, dimension(size(x),size(y)) :: dxdy
real, dimension(size(y),size(z)) :: dydz
real, dimension(size(x),size(z)) :: dxdz
real, dimension(size(x),size(y),size(z)) :: xt, yt, zt, at, bt, ct, dt, et, ft, gt
real, dimension(size(x),size(y),size(z)) :: xdp, xdm, yep, yem, zfp, zfm, xyz, divi
character(6) :: bound
logical :: sor_flag
logical, dimension(size(x),size(y),size(z)) :: inner_flag
bound(1:6)=boundary(1:6)
nx=size(x)
ny=size(y)
nz=size(z)
!-- 応答関数の初期化
if(present(init_flag))then
if(init_flag.eqv..true.)then
psi = 0.0
end if
else
psi = 0.0
end if
!-- 内部境界の判別フラグの設定
if(present(inner_bound))then
call set_bound_3d( bound, ib, inner_flag, inner_bound )
else
call set_bound_3d( bound, ib, inner_flag )
end if
!-- 領域・内部境界における境界値の設定
if(present(bound_opt))then
call setval_bound_3d( ib, bnd, psi, bound_opt )
else
call setval_bound_3d( ib, bnd, psi )
end if
!-- 未定義値の設定
if(present(undef))then
defun=undef
else
defun=0.0
end if
!-- 係数の代入
!-- xa, ya, za については, 値が入れられていなければ, 全配列に 1 を代入する.
if(present(xa))then
call set_coe_3d( xt, ext=xa )
else
call set_coe_3d( xt, def=1.0 )
end if
if(present(ya))then
call set_coe_3d( yt, ext=ya )
else
call set_coe_3d( yt, def=1.0 )
end if
if(present(za))then
call set_coe_3d( zt, ext=za )
else
call set_coe_3d( zt, def=1.0 )
end if
if(present(a))then
call set_coe_3d( at, ext=a )
signa=1
else
call set_coe_3d( at, def=0.0 )
signa=0
end if
if(present(b))then
call set_coe_3d( bt, ext=b )
signb=1
else
call set_coe_3d( bt, def=0.0 )
signb=0
end if
if(present(c))then
signc=1
call set_coe_3d( ct, ext=c )
else
call set_coe_3d( ct, def=0.0 )
signc=0
end if
if(present(d))then
call set_coe_3d( dt, ext=d )
else
call set_coe_3d( dt, def=0.0 )
end if
if(present(e))then
call set_coe_3d( et, ext=e )
else
call set_coe_3d( et, def=0.0 )
end if
if(present(f))then
call set_coe_3d( ft, ext=f )
else
call set_coe_3d( ft, def=0.0 )
end if
if(present(g))then
call set_coe_3d( gt, ext=g )
else
call set_coe_3d( gt, def=0.0 )
end if
!-- 最高階数における係数チェック. (係数がゼロでないか調べる.)
call check_coe_3d( xt, 0.0 )
call check_coe_3d( yt, 0.0 )
call check_coe_3d( zt, 0.0 )
!-- 加速係数の判定
if(present(accel))then
accc=accel
sor_flag=.true.
else
sor_flag=.false.
end if
!-- 以下で先に格子間隔等の 1 回計算でよいものを求めておく.
!-- これらは 1 方向のみで変化すればよい.
!-- 格子点間隔の計算
do i=2,nx-1
dx(i)=(x(i+1)-x(i-1))*0.5
dx2(i)=dx(i)**2
end do
do j=2,ny-1
dy(j)=(y(j+1)-y(j-1))*0.5
dy2(j)=dy(j)**2
end do
do k=2,nz-1
dz(k)=(z(k+1)-z(k-1))*0.5
dz2(k)=dz(k)**2
end do
dx(1)=(x(2)-x(1))
dx(nx)=(x(nx)-x(nx-1))
dy(1)=(y(2)-y(1))
dy(ny)=(y(ny)-y(ny-1))
dz(1)=(z(2)-z(1))
dz(nz)=(z(nz)-z(nz-1))
do j=1,ny
do i=1,nx
dxdy(i,j)=dx(i)*dy(j)
end do
end do
do k=1,nz
do j=1,ny
dydz(j,k)=dy(j)*dz(k)
end do
end do
do k=1,nz
do i=1,nx
dxdz(i,k)=dx(i)*dz(k)
end do
end do
!-- ポアソン係数の計算
!-- 実際にポアソン係数が使用されるのは, 境界を除いた 1 回り内側なので,
!-- 計算量削減のため, ループをそのようにしておく.
xyz=0.0
xdp=0.0
xdm=0.0
yep=0.0
yem=0.0
zfp=0.0
zfm=0.0
!-- 最高次数係数 ac の計算
!$omp parallel default(shared)
!$omp do schedule(dynamic) private(i,j,k)
do k=2,nz-1
do j=2,ny-1
do i=2,nx-1
xyz(i,j,k)=1.0/(2.0*(xt(i,j,k)/dx2(i)+yt(i,j,k)/dy2(j)+zt(i,j,k)/dz2(k))-gt(i,j,k))
xdp(i,j,k)=(xt(i,j,k)/(dx2(i))+0.5*dt(i,j,k)/dx(i))*xyz(i,j,k)
xdm(i,j,k)=(xt(i,j,k)/(dx2(i))-0.5*dt(i,j,k)/dx(i))*xyz(i,j,k)
yep(i,j,k)=(yt(i,j,k)/(dy2(j))+0.5*et(i,j,k)/dy(j))*xyz(i,j,k)
yem(i,j,k)=(yt(i,j,k)/(dy2(j))-0.5*et(i,j,k)/dy(j))*xyz(i,j,k)
zfp(i,j,k)=(zt(i,j,k)/(dz2(k))+0.5*ft(i,j,k)/dz(k))*xyz(i,j,k)
zfm(i,j,k)=(zt(i,j,k)/(dz2(k))-0.5*ft(i,j,k)/dz(k))*xyz(i,j,k)
if(signa==1)then
at(i,j,k)=0.25*at(i,j,k)/(dxdy(i,j))*xyz(i,j,k)
else
at(i,j,k)=0.0
end if
if(signb==1)then
bt(i,j,k)=0.25*bt(i,j,k)/(dydz(j,k))*xyz(i,j,k)
else
bt(i,j,k)=0.0
end if
if(signc==1)then
ct(i,j,k)=0.25*ct(i,j,k)/(dxdz(i,k))*xyz(i,j,k)
else
ct(i,j,k)=0.0
end if
end do
end do
end do
!$omp end do
!$omp end parallel
err_max=eps ! while に入るための便宜的措置
!-- 実際のソルバ ---
do while(err_max>=eps)
err_max=0.0
do k=1,nz
do j=1,ny
do i=1,nx
!-- 以降, 反復計算に必要な点の周囲 8 点についてそれぞれ
!-- inner_flag のチェックと同時に適切な値をそれぞれ逐次計算する,
!-- 下で, 各方向の格子計算を行っているが, ib=8,-8 は 4 隅格子のときにしか
!-- case select しない. なぜなら, 真横や上下に隅格子がくることはありえない.
if(inner_flag(i,j,k).eqv..false.)then ! .false. なら領域計算開始
tmp=-rho(i,j,k)*xyz(i,j,k)
tmp=tmp+xdp(i,j,k)*psi(i+1,j,k) +xdm(i,j,k)*psi(i-1,j,k) +yep(i,j,k)*psi(i,j+1,k) +yem(i,j,k)*psi(i,j-1,k) +zfp(i,j,k)*psi(i,j,k+1) +zfm(i,j,k)*psi(i,j,k-1)
if(signa==1)then
tmp_b=at(i,j,k)*(psi(i+1,j+1,k)+psi(i-1,j-1,k) -psi(i+1,j-1,k)-psi(i-1,j+1,k))
else
tmp_b=0.0
end if
if(signb==1)then ! そもそも bt = 0 なら計算しない.
tmp_b=tmp_b+bt(i,j,k)*(psi(i,j+1,k+1)+psi(i,j-1,k-1) -psi(i,j-1,k+1)-psi(i,j+1,k-1))
end if
if(signc==1)then ! そもそも bt = 0 なら計算しない.
tmp_b=tmp_b+ct(i,j,k)*(psi(i+1,j,k+1)+psi(i-1,j,k-1) -psi(i-1,j,k+1)-psi(i+1,j,k-1))
end if
tmp=tmp+tmp_b
else ! .true. なら境界計算開始.
select case (ib(i,j,k))
case (1)
tmp=bnd(i,j,k)
case (2) ! x 方向にフラックス一定, 上側が参照値
tmp=psi(i+1,j,k)-bnd(i,j,k)*dx(i)
case (-2) ! x 方向にフラックス一定, 下側が参照値
tmp=psi(i-1,j,k)+bnd(i,j,k)*dx(i)
case (4) ! y 方向にフラックス一定, 右側が参照値
tmp=psi(i,j+1,k)-bnd(i,j,k)*dy(j)
case (-4) ! y 方向にフラックス一定, 左側が参照値
tmp=psi(i,j-1,k)+bnd(i,j,k)*dy(j)
case (6) ! y 方向にフラックス一定, 右側が参照値
tmp=psi(i,j,k+1)-bnd(i,j,k)*dz(k)
case (-6) ! y 方向にフラックス一定, 左側が参照値
tmp=psi(i,j,k-1)+bnd(i,j,k)*dz(k)
case (3) ! 12 辺, もしくは 8 点で周期境界を判断
if(i==1)then
ix=nx-1
else if(i==nx)then
ix=2
else
ix=i
end if
if(j==1)then
jy=ny-1
else if(j==ny)then
jy=2
else
jy=j
end if
if(k==1)then
kz=nz-1
else if(k==nz)then
kz=2
else
kz=k
end if
tmp=psi(ix,jy,kz)
case (8) ! 両方フラックス一定で z 面の x, y 右上か左下角.
if(i==1.and.j==1)then ! -- 評価 1
tmp=psi(i+1,j+1,k) -0.5*(bnd(i+1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
else if(i==nx.and.j==ny)then ! -- 評価 2
tmp=psi(i-1,j-1,k) +0.5*(bnd(i-1,j,k)*dy(j)+bnd(i,j-1,k)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j-1,k)==10)then
! -- 評価 1 と同じ
tmp=psi(i+1,j+1,k) -0.5*(bnd(i+1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j+1,k)==10)then
! -- 評価 2 と同じ
tmp=psi(i-1,j-1,k) +0.5*(bnd(i-1,j,k)*dy(j)+bnd(i,j-1,k)*dx(i))
end if
case (-8) ! 両方フラックス一定で z 面の x, y 右下か左上角.
if(i==1.and.j==ny)then ! -- 評価 1
tmp=psi(i+1,j-1,k) +0.5*(bnd(i+1,j,k)*dy(j)-bnd(i,j-1,k)*dx(i))
else if(i==nx.and.j==1)then ! -- 評価 2
tmp=psi(i-1,j+1,k) +0.5*(-bnd(i-1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j+1,k)==10)then
! -- 評価 1 と同じ
tmp=psi(i+1,j-1,k) +0.5*(bnd(i+1,j,k)*dy(j)-bnd(i,j-1,k)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j-1,k)==10)then
! -- 評価 2 と同じ
tmp=psi(i-1,j+1,k) +0.5*(-bnd(i-1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
end if
case (12) ! 両方フラックス一定で y 面の x, z 右上か左下角.
if(i==1.and.k==1)then ! -- 評価 1
tmp=psi(i+1,j,k+1) -0.5*(bnd(i+1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
else if(i==nx.and.k==nz)then ! -- 評価 2
tmp=psi(i-1,j,k-1) +0.5*(bnd(i-1,j,k)*dz(k)+bnd(i,j,k-1)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 1 と同じ
tmp=psi(i+1,j,k+1) -0.5*(bnd(i+1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 2 と同じ
tmp=psi(i-1,j,k-1) +0.5*(bnd(i-1,j,k)*dz(k)+bnd(i,j,k-1)*dx(i))
end if
case (-12) ! 両方フラックス一定で y 面の x, z 右下か左上角.
if(i==1.and.k==nz)then ! -- 評価 1
tmp=psi(i+1,j,k-1) +0.5*(bnd(i+1,j,k)*dz(k)-bnd(i,j,k-1)*dx(i))
else if(i==nx.and.k==1)then ! -- 評価 2
tmp=psi(i-1,j,k+1) +0.5*(-bnd(i-1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 1 と同じ
tmp=psi(i+1,j,k-1) +0.5*(bnd(i+1,j,k)*dz(k)-bnd(i,j,k-1)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 2 と同じ
tmp=psi(i-1,j,k+1) +0.5*(-bnd(i-1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
end if
case (24) ! 両方フラックス一定で x 面の y, z 右上か左下角.
if(j==1.and.k==1)then ! -- 評価 1
tmp=psi(i,j+1,k+1) -0.5*(bnd(i,j+1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
else if(j==ny.and.k==nz)then ! -- 評価 2
tmp=psi(i,j-1,k-1) +0.5*(bnd(i,j-1,k)*dz(k)+bnd(i,j,k-1)*dy(j))
else if(ib(i,j-1,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 1 と同じ
tmp=psi(i,j+1,k+1) -0.5*(bnd(i,j+1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
else if(ib(i,j+1,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 2 と同じ
tmp=psi(i,j-1,k-1) +0.5*(bnd(i,j-1,k)*dz(k)+bnd(i,j,k-1)*dy(j))
end if
case (-24) ! 両方フラックス一定で x 面の y, z 右下か左上角.
if(j==1.and.k==nz)then ! -- 評価 1
tmp=psi(i,j+1,k-1) +0.5*(bnd(i,j+1,k)*dz(k)-bnd(i,j,k-1)*dy(j))
else if(j==ny.and.k==1)then ! -- 評価 2
tmp=psi(i,j-1,k+1) +0.5*(-bnd(i,j-1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
else if(ib(i,j-1,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 1 と同じ
tmp=psi(i,j+1,k-1) +0.5*(bnd(i,j+1,k)*dz(k)-bnd(i,j,k-1)*dy(j))
else if(ib(i,j+1,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 2 と同じ
tmp=psi(i,j-1,k+1) +0.5*(-bnd(i,j-1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
end if
!-- 以降, 隅領域なので, 個別に設定.
case (11) ! 両方フラックス一定で (1,1,1) 点, もしくは内部領域.
tmp=psi(i+1,j+1,k+1) -(bnd(i,j+1,k+1)*dx(i) +bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j+1,k)*dz(k))/3.0
case (13) ! 両方フラックス一定で (nx,1,1) 点, もしくは内部領域.
tmp=psi(i-1,j+1,k+1) -(-bnd(i,j+1,k+1)*dx(i) +bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j+1,k)*dz(k))/3.0
case (17) ! 両方フラックス一定で (1,ny,1) 点, もしくは内部領域.
tmp=psi(i+1,j-1,k+1) -(bnd(i,j-1,k+1)*dx(i) -bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j-1,k)*dz(k))/3.0
case (19) ! 両方フラックス一定で (nx,ny,1) 点, もしくは内部領域.
tmp=psi(i-1,j-1,k+1) -(-bnd(i,j-1,k+1)*dx(i) -bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j-1,k)*dz(k))/3.0
case (23) ! 両方フラックス一定で (1,1,nz) 点, もしくは内部領域.
tmp=psi(i+1,j+1,k-1) -(bnd(i,j+1,k-1)*dx(i) +bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j+1,k)*dz(k))/3.0
case (29) ! 両方フラックス一定で (nx,1,nz) 点, もしくは内部領域.
tmp=psi(i-1,j+1,k-1) -(-bnd(i,j+1,k-1)*dx(i) +bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j+1,k)*dz(k))/3.0
case (31) ! 両方フラックス一定で (1,ny,nz) 点, もしくは内部領域.
tmp=psi(i+1,j-1,k-1) -(bnd(i,j-1,k-1)*dx(i) -bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j-1,k)*dz(k))/3.0
case (37) ! 両方フラックス一定で (nx,ny,nz) 点, もしくは内部領域.
tmp=psi(i-1,j-1,k-1) -(-bnd(i,j-1,k-1)*dx(i) -bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j-1,k)*dz(k))/3.0
case (-11) ! 両方フラックス一定で (i+1,j+1,k+1) に 10 が設定.
tmp=(psi(i-1,j+1,k+1)+psi(i+1,j-1,k+1)+psi(i+1,j+1,k-1) +bnd(i,j+1,k+1)*dx(i)+bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j+1,k)*dz(k))/3.0
case (-13) ! 両方フラックス一定で (i-1,j+1,k+1) に 10 が設定.
tmp=(psi(i+1,j+1,k+1)+psi(i-1,j-1,k+1)+psi(i-1,j+1,k-1) -bnd(i,j+1,k+1)*dx(i)+bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j+1,k)*dz(k))/3.0
case (-17) ! 両方フラックス一定で (i+1,j-1,k+1) に 10 が設定.
tmp=(psi(i-1,j-1,k+1)+psi(i+1,j+1,k+1)+psi(i+1,j-1,k-1) +bnd(i,j-1,k+1)*dx(i)-bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j-1,k)*dz(k))/3.0
case (-19) ! 両方フラックス一定で (i-1,j-1,k+1) に 10 が設定.
tmp=(psi(i+1,j-1,k+1)+psi(i-1,j+1,k+1)+psi(i-1,j-1,k-1) -bnd(i,j-1,k+1)*dx(i)-bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j-1,k)*dz(k))/3.0
case (-23) ! 両方フラックス一定で (i+1,j+1,k-1) に 10 が設定.
tmp=(psi(i-1,j+1,k-1)+psi(i+1,j-1,k-1)+psi(i+1,j+1,k+1) +bnd(i,j+1,k-1)*dx(i)+bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j+1,k)*dz(k))/3.0
case (-29) ! 両方フラックス一定で (i-1,j+1,k-1) に 10 が設定.
tmp=(psi(i+1,j+1,k-1)+psi(i-1,j-1,k-1)+psi(i-1,j+1,k+1) -bnd(i,j+1,k-1)*dx(i)+bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j+1,k)*dz(k))/3.0
case (-31) ! 両方フラックス一定で (i+1,j-1,k-1) に 10 が設定.
tmp=(psi(i-1,j-1,k-1)+psi(i+1,j+1,k-1)+psi(i+1,j-1,k+1) +bnd(i,j-1,k-1)*dx(i)-bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j-1,k)*dz(k))/3.0
case (-37) ! 両方フラックス一定で (i-1,j-1,k-1) に 10 が設定.
tmp=(psi(i+1,j-1,k-1)+psi(i-1,j+1,k-1)+psi(i-1,j-1,k+1) -bnd(i,j-1,k-1)*dx(i)-bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j-1,k)*dz(k))/3.0
end select
end if
if(sor_flag.eqv..true.)then
tmp=(1.0-accc)*psi(i,j,k)+tmp*accc
end if
err=abs(tmp-psi(i,j,k))
!-- 最大誤差の更新
if(err_max<=err)then
err_max=err
end if
psi(i,j,k)=tmp
end do
end do
end do
end do
!-- 境界の設定
call calculate_bound_3d( ib, dx, dy, dz, bnd, psi )
!-- 未定義領域には undef を代入する.
do k=1,nz
do j=1,ny
do i=1,nx
if(ib(i,j,k)==10)then
psi(i,j,k)=defun
end if
end do
end do
end do
end subroutine Ellip_GauSei_3d
| Subroutine : | |||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| rho(size(x),size(y)) : | real, intent(in)
| ||
| eps : | real, intent(in)
| ||
| boundary : | character(4), intent(in)
| ||
| psi(size(x),size(y)) : | real, intent(inout)
| ||
| bound_opt(size(x),size(y)) : | real, intent(in), optional
| ||
| a(size(x),size(y)) : | real, intent(in), optional
| ||
| b(size(x),size(y)) : | real, intent(in), optional
| ||
| c(size(x),size(y)) : | real, intent(in), optional
| ||
| d(size(x),size(y)) : | real, intent(in), optional
| ||
| e(size(x),size(y)) : | real, intent(in), optional
| ||
| f(size(x),size(y)) : | real, intent(in), optional
| ||
| undef : | real, intent(in), optional
| ||
| inner_bound(size(x),size(y)) : | integer, intent(in), optional
| ||
| init_flag : | logical, intent(in), optional
| ||
| accel : | real, intent(in), optional
|
openmp によるスレッド並列が可能. ガウス・ザイデル法ではアルゴリズムの点から並列化が困難と思われたので, 並列計算によるポアソン方程式の求積が必要となるなら, ヤコビ法のものを使用されたい.
subroutine Ellip_Jacobi_2d( x, y, rho, eps, boundary, psi, bound_opt, a, b, c, d, e, f, undef, inner_bound, init_flag, accel )
! openmp によるスレッド並列が可能.
! ガウス・ザイデル法ではアルゴリズムの点から並列化が困難と思われたので,
! 並列計算によるポアソン方程式の求積が必要となるなら,
! ヤコビ法のものを使用されたい.
implicit none
real, intent(in) :: x(:) ! 領域の横座標
real, intent(in) :: y(:) ! 領域の縦座標
real, intent(in) :: rho(size(x),size(y)) ! ポアソン方程式の強制項
! rho =0 でラプラス方程式も求積可能
real, intent(in) :: eps ! 収束条件
character(4), intent(in) :: boundary ! 境界条件
! 4 文字で各辺の境界条件を与える.
! 1 文字目 : x 下端, 2 文字目 : y 左端, 3 文字目 : x 上端,
! 4 文字目 : y 右端
! boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
real, intent(in), optional :: bound_opt(size(x),size(y)) ! 境界での強制
! ノイマン境界の場合 : フラックス値
real, intent(in), optional :: a(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: b(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: c(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: d(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: e(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: f(size(x),size(y)) ! 各微分項の係数
real, intent(in), optional :: undef ! 未定義値
integer, intent(in), optional :: inner_bound(size(x),size(y))
! 内部領域の境界. 値に応じてその格子点で境界値計算
! 1 = 固定端境界, 10 = 境界の内側.
! 2 = y 方向自由端境界 (フラックスは上向き)
! -2 = y 方向自由端境界 (フラックスは下向き)
! 4 = x 方向自由端境界 (フラックスは右向き)
! -4 = x 方向自由端境界 (フラックスは左向き)
! 3 = 周期境界, -3 = 隅領域で両方とも周期境界
! 8 = |_, ~| で両方とも自由境界条件
! -8 = |~, _| で両方とも自由境界条件
! この引数が与えられなければ全領域を計算する.
! 境界の内側格子点 (10) は反復計算を行わず,
! undef で設定された値もしくはゼロが入る.
! このときの境界値は bound_opt の値が用いられる.
real, intent(inout) :: psi(size(x),size(y)) ! ポアソン方程式の解
logical, intent(in), optional :: init_flag ! psi の値をゼロで初期化するか.
! .true. = 初期化する. .false. = 初期化しない.
! デフォルトでは初期化する.
real, intent(in), optional :: accel ! SOR の加速係数 (0 < accel < 2)
! デフォルト = 1
integer :: i, j, ix, jy
integer :: nx ! x 方向の配列要素
integer :: ny ! y 方向の配列要素
integer :: signb ! クロスターム b が存在するか
integer, dimension(size(x),size(y)) :: ib
real :: defun
real :: err, err_max, accc
real :: bnd(size(x),size(y))
real :: dx(size(x)), dy(size(y)), dx2(size(x)), dy2(size(y))
real, dimension(size(x),size(y)) :: dxdy
real, dimension(size(x),size(y)) :: at, bt, ct, dt, et, ft
real, dimension(size(x),size(y)) :: adp, adm, cep, cem, ac
real, dimension(size(x),size(y)) :: tmp, tmp_b, divi
character(4) :: bound
logical :: sor_flag
logical, dimension(size(x),size(y)) :: inner_flag
bound(1:4)=boundary(1:4)
nx=size(x)
ny=size(y)
!-- 応答関数の初期化
if(present(init_flag))then
if(init_flag.eqv..true.)then
psi = 0.0
end if
else
psi = 0.0
end if
!-- 内部境界の判別フラグの設定
if(present(inner_bound))then
call set_bound( bound, ib, inner_flag, inner_bound )
else
call set_bound( bound, ib, inner_flag )
end if
!-- 領域・内部境界における境界値の設定
if(present(bound_opt))then
call setval_bound( ib, bnd, psi, bound_opt )
else
call setval_bound( ib, bnd, psi )
end if
!-- 未定義値の設定
if(present(undef))then
defun=undef
else
defun=0.0
end if
!-- 係数の代入
!-- a, c については, 値が入れられていなければ, 全配列に 1 を代入する.
if(present(a))then
call set_coe( at, ext=a )
else
call set_coe( at, def=1.0 )
end if
if(present(c))then
call set_coe( ct, ext=c )
else
call set_coe( ct, def=1.0 )
end if
if(present(b))then
call set_coe( bt, ext=b )
signb=1
else
call set_coe( bt, def=0.0 )
signb=0
end if
if(present(d))then
call set_coe( dt, ext=d )
else
call set_coe( dt, def=0.0 )
end if
if(present(e))then
call set_coe( et, ext=e )
else
call set_coe( et, def=0.0 )
end if
if(present(f))then
call set_coe( ft, ext=f )
else
call set_coe( ft, def=0.0 )
end if
!-- 最高階数における係数チェック. (係数がゼロでないか調べる.)
call check_coe( at, 0.0 )
call check_coe( ct, 0.0 )
!-- 加速係数の判定
if(present(accel))then
accc=accel
sor_flag=.true.
else
sor_flag=.false.
end if
!-- 以下で先に格子間隔等の 1 回計算でよいものを求めておく.
!-- これらは 1 方向のみで変化すればよい.
!-- 格子点間隔の計算
do i=2,nx-1
dx(i)=(x(i+1)-x(i-1))*0.5
dx2(i)=dx(i)**2
end do
do j=2,ny-1
dy(j)=(y(j+1)-y(j-1))*0.5
dy2(j)=dy(j)**2
end do
dx(1)=(x(2)-x(1))
dx(nx)=(x(nx)-x(nx-1))
dy(1)=(y(2)-y(1))
dy(ny)=(y(ny)-y(ny-1))
do j=1,ny
do i=1,nx
dxdy(i,j)=dx(i)*dy(j)
end do
end do
!-- ポアソン係数の計算
!-- 実際にポアソン係数が使用されるのは, 境界を除いた 1 回り内側なので,
!-- 計算量削減のため, ループをそのようにしておく.
ac=0.0
adp=0.0
adm=0.0
cep=0.0
cem=0.0
bt=0.0
!-- 最高次数係数 ac の計算
!$omp parallel default(shared)
!$omp do schedule(dynamic) private(i,j)
do j=2,ny-1
do i=2,nx-1
ac(i,j)=1.0/(2.0*(at(i,j)/dx2(i)+ct(i,j)/dy2(j))-ft(i,j))
adp(i,j)=(at(i,j)/(dx2(i))+0.5*dt(i,j)/dx(i))*ac(i,j)
adm(i,j)=(at(i,j)/(dx2(i))-0.5*dt(i,j)/dx(i))*ac(i,j)
cep(i,j)=(ct(i,j)/(dy2(j))+0.5*et(i,j)/dy(j))*ac(i,j)
cem(i,j)=(ct(i,j)/(dy2(j))-0.5*et(i,j)/dy(j))*ac(i,j)
bt(i,j)=0.25*bt(i,j)/(dxdy(i,j))*ac(i,j)
end do
end do
!$omp end do
!$omp end parallel
err_max=eps ! while に入るための便宜的措置
!-- 実際のソルバ ---
do while(err_max>=eps)
err_max=0.0
!$omp parallel default(shared)
!$omp do schedule(dynamic) private(i,j,ix,jy)
do j=1,ny
do i=1,nx
!-- 以降, 反復計算に必要な点の周囲 8 点についてそれぞれ
!-- inner_flag のチェックと同時に適切な値をそれぞれ逐次計算する,
!-- 下で, 各方向の格子計算を行っているが, ib=8,-8 は 4 隅格子のときにしか
!-- case select しない. なぜなら, 真横や上下に隅格子がくることはありえない.
if(inner_flag(i,j).eqv..false.)then ! .false. なら領域計算開始
tmp(i,j)=-rho(i,j)*ac(i,j)
tmp(i,j)=tmp(i,j)+adp(i,j)*psi(i+1,j) +adm(i,j)*psi(i-1,j) +cep(i,j)*psi(i,j+1) +cem(i,j)*psi(i,j-1)
if(signb==0)then ! そもそも bt = 0 なら計算しない.
tmp_b(i,j)=0.0
else
tmp_b(i,j)=bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))
end if
tmp(i,j)=tmp(i,j)+tmp_b(i,j)
else ! .true. なら境界計算に移行.
select case (ib(i,j))
case (1)
tmp(i,j)=bnd(i,j)
case (2) ! x 方向にフラックス一定, 上側が参照値
tmp(i,j)=psi(i+1,j)-bnd(i,j)*dx(i)
case (-2) ! x 方向にフラックス一定, 下側が参照値
tmp(i,j)=psi(i-1,j)+bnd(i,j)*dx(i)
case (4) ! y 方向にフラックス一定, 右側が参照値
tmp(i,j)=psi(i,j+1)-bnd(i,j)*dy(j)
case (-4) ! y 方向にフラックス一定, 左側が参照値
tmp(i,j)=psi(i,j-1)+bnd(i,j)*dy(j)
case (3) ! 周期境界
if(i==1)then
ix=nx-1
else if(i==nx)then
ix=2
else
ix=i
end if
if(j==1)then
jy=ny-1
else if(j==ny)then
jy=2
else
jy=j
end if
tmp(i,j)=psi(ix,jy)
case (7) ! 両方フラックス一定で内部境界限定.
if((ib(i+1,j+1)==10).and.(ib(i+1,j)/=10).and. (ib(i,j+1)/=10))then
tmp(i,j)=0.5*(psi(i-1,j)+psi(i,j-1)) +0.5*bnd(i,j)*(dy(j)+dx(i))
else if((ib(i-1,j-1)==10).and.(ib(i-1,j)/=10).and. (ib(i,j-1)/=10))then
tmp(i,j)=0.5*(psi(i+1,j)+psi(i,j+1)) -0.5*bnd(i,j)*(dy(j)+dx(i))
end if
case (-7) ! 両方フラックス一定で内部境界限定.
if((ib(i-1,j+1)==10).and.(ib(i-1,j)/=10).and. (ib(i,j+1)/=10))then
tmp(i,j)=0.5*(psi(i+1,j)+psi(i,j-1)) +0.5*bnd(i,j)*(dy(j)-dx(i))
else if((ib(i+1,j-1)==10).and.(ib(i+1,j)/=10).and. (ib(i,j-1)/=10))then
tmp(i,j)=0.5*(psi(i-1,j)+psi(i,j+1)) +0.5*bnd(i,j)*(-dy(j)+dx(i))
end if
case (8) ! 両方フラックス一定で左下角か右上角, もしくは内部境界.
if(i==1.and.j==1)then ! -- 評価 1
tmp(i,j)=psi(i+1,j+1)-0.5*(bnd(i+1,j)*dy(j)+bnd(i,j+1)*dx(i))
else if(i==nx.and.j==ny)then ! -- 評価 2
tmp(i,j)=psi(i-1,j-1)+0.5*(bnd(i-1,j)*dy(j)+bnd(i,j-1)*dx(i))
else if(ib(i-1,j)==10.and.ib(i,j-1)==10)then
! -- 評価 1 と同じ
tmp(i,j)=psi(i+1,j+1)-0.5*(bnd(i+1,j)*dy(j)+bnd(i,j+1)*dx(i))
else if(ib(i+1,j)==10.and.ib(i,j+1)==10)then
! -- 評価 2 と同じ
tmp(i,j)=psi(i-1,j-1)+0.5*(bnd(i-1,j)*dy(j)+bnd(i,j-1)*dx(i))
end if
case (-8) ! 両方フラックス一定で右下角か左上角
if(i==1.and.j==ny)then ! -- 評価 1
tmp(i,j)=psi(i+1,j-1)+0.5*(bnd(i+1,j)*dy(j)-bnd(i,j-1)*dx(i))
else if(i==nx.and.j==1)then ! -- 評価 2
tmp(i,j)=psi(i-1,j+1)+0.5*(-bnd(i-1,j)*dy(j)+bnd(i,j+1)*dx(i))
else if(ib(i-1,j)==10.and.ib(i,j+1)==10)then
! -- 評価 1 と同じ
tmp(i,j)=psi(i+1,j-1)+0.5*(bnd(i+1,j)*dy(j)-bnd(i,j-1)*dx(i))
else if(ib(i+1,j)==10.and.ib(i,j-1)==10)then
! -- 評価 2 と同じ
tmp(i,j)=psi(i-1,j+1)+0.5*(-bnd(i-1,j)*dy(j)+bnd(i,j+1)*dx(i))
end if
end select
end if
if(sor_flag.eqv..true.)then
tmp(i,j)=(1.0-accc)*psi(i,j)+tmp(i,j)*accc
end if
end do
end do
!$omp end do
!$omp end parallel
!!-- ここまでは if 文のインデントを調節しない.
! end if
!
! tmp=tmp/ac(i,j)
!-- 誤差の計算 ---
do j=2,ny-1
do i=2,nx-1
err=abs(tmp(i,j)-psi(i,j))
!-- 最大誤差の更新
if(err_max<=err)then
err_max=err
end if
end do
end do
!-- 一斉更新
do j=1,ny
do i=1,nx
psi(i,j)=tmp(i,j)
end do
end do
end do
!-- 境界の設定
call calculate_bound( ib, dx, dy, bnd, psi )
!-- 未定義領域には undef を代入する.
do j=1,ny
do i=1,nx
if(ib(i,j)==10)then
psi(i,j)=defun
end if
end do
end do
end subroutine Ellip_Jacobi_2d
| Subroutine : | |||
| x(:) : | real, intent(in)
| ||
| y(:) : | real, intent(in)
| ||
| z(:) : | real, intent(in)
| ||
| rho(size(x),size(y),size(z)) : | real, intent(in)
| ||
| eps : | real, intent(in)
| ||
| boundary : | character(6), intent(in)
| ||
| psi(size(x),size(y),size(z)) : | real, intent(inout)
| ||
| bound_opt(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| xa(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| ya(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| za(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| a(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| b(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| c(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| d(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| e(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| f(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| g(size(x),size(y),size(z)) : | real, intent(in), optional
| ||
| undef : | real, intent(in), optional
| ||
| inner_bound(size(x),size(y),size(z)) : | integer, intent(in), optional
| ||
| init_flag : | logical, intent(in), optional
| ||
| accel : | real, intent(in), optional
|
subroutine Ellip_Jacobi_3d(x, y, z, rho, eps, boundary, psi, bound_opt, xa, ya, za, a, b, c, d, e, f, g, undef, inner_bound, init_flag, accel )
use omp_lib
! openmp によるスレッド並列が可能.
! ガウス・ザイデル法ではアルゴリズムの点から並列化が困難と思われたので,
! 並列計算によるポアソン方程式の求積が必要となるなら,
! ヤコビ法のものを使用されたい.
! 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される.
! $$xa\dfrac{\partial ^2\psi}{\partial x^2} +ya\dfrac{\partial ^2\psi}{\partial y^2} +za\dfrac{\partial ^2\psi}{\partial z^2} +a\dfrac{\partial ^2\psi}{\partial x\partial y} +b\dfrac{\partial ^2\psi}{\partial y\partial z} +c\dfrac{\partial ^2\psi}{\partial z\partial x} +d\dfrac{\partial \psi}{\partial x} +e\dfrac{\partial \psi}{\partial y} +f\dfrac{\partial \psi}{\partial z} +g\psi =\rho $$
! の各係数に対応している.
implicit none
real, intent(in) :: x(:) ! 領域の x 座標
real, intent(in) :: y(:) ! 領域の y 座標
real, intent(in) :: z(:) ! 領域の z 座標
real, intent(in) :: rho(size(x),size(y),size(z)) ! ポアソン方程式の強制項
! rho =0 でラプラス方程式も求積可能
real, intent(in) :: eps ! 収束条件
character(6), intent(in) :: boundary ! 境界条件
! 4 文字で各辺の境界条件を与える.
! 1 文字目 : x 下端, 2 文字目 : y 左端, 3 文字目 : x 上端,
! 4 文字目 : y 右端
! boundary は 1 : 固定端境界, 2 : 自由端境界, 3 : 周期境界
real, intent(in), optional :: bound_opt(size(x),size(y),size(z))
! 境界での強制
! ノイマン境界の場合 : フラックス値
real, intent(in), optional :: xa(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: ya(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: za(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: a(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: b(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: c(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: d(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: e(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: f(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(in), optional :: g(size(x),size(y),size(z)) ! 各微分項の係数
real, intent(inout) :: psi(size(x),size(y),size(z)) ! ポアソン方程式の解
real, intent(in), optional :: undef ! 未定義値
integer, intent(in), optional :: inner_bound(size(x),size(y),size(z))
! 内部領域の境界. 値に応じてその格子点で境界値計算
! 1 = 固定端境界, 10 = 境界の内側.
! 2 = y 方向自由端境界 (フラックスは上向き)
! -2 = y 方向自由端境界 (フラックスは下向き)
! 4 = x 方向自由端境界 (フラックスは右向き)
! -4 = x 方向自由端境界 (フラックスは左向き)
! 3 = 周期境界
! 8 = |_, ~| で両方とも自由境界条件
! -8 = |~, _| で両方とも自由境界条件
! この引数が与えられなければ全領域を計算する.
! 境界の内側格子点 (10) は反復計算を行わず,
! undef で設定された値もしくはゼロが入る.
! このときの境界値は bound_opt の値が用いられる.
logical, intent(in), optional :: init_flag ! psi の値をゼロで初期化するか.
! .true. = 初期化する. .false. = 初期化しない.
! デフォルトでは初期化する.
real, intent(in), optional :: accel ! SOR の加速係数 (0 < accel < 2)
! デフォルト = 1
integer :: i, j, k, ix, jy, kz
integer :: nx ! x 方向の配列要素
integer :: ny ! y 方向の配列要素
integer :: nz ! z 方向の配列要素
integer :: signa, signb, signc ! 各係数を計算するかどうか
integer, dimension(size(x),size(y),size(z)) :: ib
real :: defun
real :: err, err_max, accc
real :: bnd(size(x),size(y),size(z))
real :: dx(size(x)), dy(size(y)), dx2(size(x)), dy2(size(y))
real :: dz(size(z)), dz2(size(z))
real, dimension(size(x),size(y)) :: dxdy
real, dimension(size(y),size(z)) :: dydz
real, dimension(size(x),size(z)) :: dxdz
real, dimension(size(x),size(y),size(z)) :: xt, yt, zt, at, bt, ct, dt, et, ft, gt
real, dimension(size(x),size(y),size(z)) :: xdp, xdm, yep, yem, zfp, zfm, xyz, divi
real, dimension(size(x),size(y),size(z)) :: tmp, tmp_b
character(6) :: bound
logical :: sor_flag
logical, dimension(size(x),size(y),size(z)) :: inner_flag
bound(1:6)=boundary(1:6)
nx=size(x)
ny=size(y)
nz=size(z)
!-- 応答関数の初期化
if(present(init_flag))then
if(init_flag.eqv..true.)then
psi = 0.0
end if
else
psi = 0.0
end if
!-- 内部境界の判別フラグの設定
if(present(inner_bound))then
call set_bound_3d( bound, ib, inner_flag, inner_bound )
else
call set_bound_3d( bound, ib, inner_flag )
end if
!-- 領域・内部境界における境界値の設定
if(present(bound_opt))then
call setval_bound_3d( ib, bnd, psi, bound_opt )
else
call setval_bound_3d( ib, bnd, psi )
end if
!-- 未定義値の設定
if(present(undef))then
defun=undef
else
defun=0.0
end if
!-- 係数の代入
!-- xa, ya, za については, 値が入れられていなければ, 全配列に 1 を代入する.
if(present(xa))then
call set_coe_3d( xt, ext=xa )
else
call set_coe_3d( xt, def=1.0 )
end if
if(present(ya))then
call set_coe_3d( yt, ext=ya )
else
call set_coe_3d( yt, def=1.0 )
end if
if(present(za))then
call set_coe_3d( zt, ext=za )
else
call set_coe_3d( zt, def=1.0 )
end if
if(present(a))then
call set_coe_3d( at, ext=a )
signa=1
else
call set_coe_3d( at, def=0.0 )
signa=0
end if
if(present(b))then
call set_coe_3d( bt, ext=b )
signb=1
else
call set_coe_3d( bt, def=0.0 )
signb=0
end if
if(present(c))then
signc=1
call set_coe_3d( ct, ext=c )
else
call set_coe_3d( ct, def=0.0 )
signc=0
end if
if(present(d))then
call set_coe_3d( dt, ext=d )
else
call set_coe_3d( dt, def=0.0 )
end if
if(present(e))then
call set_coe_3d( et, ext=e )
else
call set_coe_3d( et, def=0.0 )
end if
if(present(f))then
call set_coe_3d( ft, ext=f )
else
call set_coe_3d( ft, def=0.0 )
end if
if(present(g))then
call set_coe_3d( gt, ext=g )
else
call set_coe_3d( gt, def=0.0 )
end if
!-- 最高階数における係数チェック. (係数がゼロでないか調べる.)
call check_coe_3d( xt, 0.0 )
call check_coe_3d( yt, 0.0 )
call check_coe_3d( zt, 0.0 )
!-- 加速係数の判定
if(present(accel))then
accc=accel
sor_flag=.true.
else
sor_flag=.false.
end if
!-- 以下で先に格子間隔等の 1 回計算でよいものを求めておく.
!-- これらは 1 方向のみで変化すればよい.
!-- 格子点間隔の計算
do i=2,nx-1
dx(i)=(x(i+1)-x(i-1))*0.5
dx2(i)=dx(i)**2
end do
do j=2,ny-1
dy(j)=(y(j+1)-y(j-1))*0.5
dy2(j)=dy(j)**2
end do
do k=2,nz-1
dz(k)=(z(k+1)-z(k-1))*0.5
dz2(k)=dz(k)**2
end do
dx(1)=(x(2)-x(1))
dx(nx)=(x(nx)-x(nx-1))
dy(1)=(y(2)-y(1))
dy(ny)=(y(ny)-y(ny-1))
dz(1)=(z(2)-z(1))
dz(nz)=(z(nz)-z(nz-1))
do j=1,ny
do i=1,nx
dxdy(i,j)=dx(i)*dy(j)
end do
end do
do k=1,nz
do j=1,ny
dydz(j,k)=dy(j)*dz(k)
end do
end do
do k=1,nz
do i=1,nx
dxdz(i,k)=dx(i)*dz(k)
end do
end do
!-- ポアソン係数の計算
!-- 実際にポアソン係数が使用されるのは, 境界を除いた 1 回り内側なので,
!-- 計算量削減のため, ループをそのようにしておく.
xyz=0.0
xdp=0.0
xdm=0.0
yep=0.0
yem=0.0
zfp=0.0
zfm=0.0
!-- 最高次数係数 ac の計算
!$omp parallel default(shared)
!$omp do schedule(dynamic) private(i,j,k)
do k=2,nz-1
do j=2,ny-1
do i=2,nx-1
xyz(i,j,k)=1.0/(2.0*(xt(i,j,k)/dx2(i)+yt(i,j,k)/dy2(j)+zt(i,j,k)/dz2(k))-gt(i,j,k))
xdp(i,j,k)=(xt(i,j,k)/(dx2(i))+0.5*dt(i,j,k)/dx(i))*xyz(i,j,k)
xdm(i,j,k)=(xt(i,j,k)/(dx2(i))-0.5*dt(i,j,k)/dx(i))*xyz(i,j,k)
yep(i,j,k)=(yt(i,j,k)/(dy2(j))+0.5*et(i,j,k)/dy(j))*xyz(i,j,k)
yem(i,j,k)=(yt(i,j,k)/(dy2(j))-0.5*et(i,j,k)/dy(j))*xyz(i,j,k)
zfp(i,j,k)=(zt(i,j,k)/(dz2(k))+0.5*ft(i,j,k)/dz(k))*xyz(i,j,k)
zfm(i,j,k)=(zt(i,j,k)/(dz2(k))-0.5*ft(i,j,k)/dz(k))*xyz(i,j,k)
if(signa==1)then
at(i,j,k)=0.25*at(i,j,k)/(dxdy(i,j))*xyz(i,j,k)
else
at(i,j,k)=0.0
end if
if(signb==1)then
bt(i,j,k)=0.25*bt(i,j,k)/(dydz(j,k))*xyz(i,j,k)
else
bt(i,j,k)=0.0
end if
if(signc==1)then
ct(i,j,k)=0.25*ct(i,j,k)/(dxdz(i,k))*xyz(i,j,k)
else
ct(i,j,k)=0.0
end if
end do
end do
end do
!$omp end do
!$omp end parallel
err_max=eps ! while に入るための便宜的措置
!-- 実際のソルバ ---
do while(err_max>=eps)
err_max=0.0
!$omp parallel default(shared)
!$omp do schedule(dynamic) private(i,j,k,ix,jy,kz)
do k=1,nz
do j=1,ny
do i=1,nx
!-- 以降, 反復計算に必要な点の周囲 8 点についてそれぞれ
!-- inner_flag のチェックと同時に適切な値をそれぞれ逐次計算する,
!-- 下で, 各方向の格子計算を行っているが, ib=8,-8 は 4 隅格子のときにしか
!-- case select しない. なぜなら, 真横や上下に隅格子がくることはありえない.
if(inner_flag(i,j,k).eqv..false.)then ! .false. なら領域計算開始
tmp(i,j,k)=-rho(i,j,k)*xyz(i,j,k)
tmp(i,j,k)=tmp(i,j,k)+xdp(i,j,k)*psi(i+1,j,k) +xdm(i,j,k)*psi(i-1,j,k) +yep(i,j,k)*psi(i,j+1,k) +yem(i,j,k)*psi(i,j-1,k) +zfp(i,j,k)*psi(i,j,k+1) +zfm(i,j,k)*psi(i,j,k-1)
if(signa==1)then
tmp_b(i,j,k)=at(i,j,k)*(psi(i+1,j+1,k)+psi(i-1,j-1,k) -psi(i+1,j-1,k)-psi(i-1,j+1,k))
else
tmp_b(i,j,k)=0.0
end if
if(signb==1)then ! そもそも bt = 0 なら計算しない.
tmp_b(i,j,k)=tmp_b(i,j,k) +bt(i,j,k)*(psi(i,j+1,k+1)+psi(i,j-1,k-1) -psi(i,j-1,k+1)-psi(i,j+1,k-1))
end if
if(signc==1)then ! そもそも bt = 0 なら計算しない.
tmp_b(i,j,k)=tmp_b(i,j,k) +ct(i,j,k)*(psi(i+1,j,k+1)+psi(i-1,j,k-1) -psi(i-1,j,k+1)-psi(i+1,j,k-1))
end if
tmp(i,j,k)=tmp(i,j,k)+tmp_b(i,j,k)
else ! .true. なら境界計算開始.
select case (ib(i,j,k))
case (1)
tmp(i,j,k)=bnd(i,j,k)
case (2) ! x 方向にフラックス一定, 上側が参照値
tmp(i,j,k)=psi(i+1,j,k)-bnd(i,j,k)*dx(i)
case (-2) ! x 方向にフラックス一定, 下側が参照値
tmp(i,j,k)=psi(i-1,j,k)+bnd(i,j,k)*dx(i)
case (4) ! y 方向にフラックス一定, 右側が参照値
tmp(i,j,k)=psi(i,j+1,k)-bnd(i,j,k)*dy(j)
case (-4) ! y 方向にフラックス一定, 左側が参照値
tmp(i,j,k)=psi(i,j-1,k)+bnd(i,j,k)*dy(j)
case (6) ! y 方向にフラックス一定, 右側が参照値
tmp(i,j,k)=psi(i,j,k+1)-bnd(i,j,k)*dz(k)
case (-6) ! y 方向にフラックス一定, 左側が参照値
tmp(i,j,k)=psi(i,j,k-1)+bnd(i,j,k)*dz(k)
case (3) ! 12 辺, もしくは 8 点で周期境界を判断
if(i==1)then
ix=nx-1
else if(i==nx)then
ix=2
else
ix=i
end if
if(j==1)then
jy=ny-1
else if(j==ny)then
jy=2
else
jy=j
end if
if(k==1)then
kz=nz-1
else if(k==nz)then
kz=2
else
kz=k
end if
tmp(i,j,k)=psi(ix,jy,kz)
case (8) ! 両方フラックス一定で z 面の x, y 右上か左下角.
if(i==1.and.j==1)then ! -- 評価 1
tmp(i,j,k)=psi(i+1,j+1,k) -0.5*(bnd(i+1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
else if(i==nx.and.j==ny)then ! -- 評価 2
tmp(i,j,k)=psi(i-1,j-1,k) +0.5*(bnd(i-1,j,k)*dy(j)+bnd(i,j-1,k)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j-1,k)==10)then
! -- 評価 1 と同じ
tmp(i,j,k)=psi(i+1,j+1,k) -0.5*(bnd(i+1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j+1,k)==10)then
! -- 評価 2 と同じ
tmp(i,j,k)=psi(i-1,j-1,k) +0.5*(bnd(i-1,j,k)*dy(j)+bnd(i,j-1,k)*dx(i))
end if
case (-8) ! 両方フラックス一定で z 面の x, y 右下か左上角.
if(i==1.and.j==ny)then ! -- 評価 1
tmp(i,j,k)=psi(i+1,j-1,k) +0.5*(bnd(i+1,j,k)*dy(j)-bnd(i,j-1,k)*dx(i))
else if(i==nx.and.j==1)then ! -- 評価 2
tmp(i,j,k)=psi(i-1,j+1,k) +0.5*(-bnd(i-1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j+1,k)==10)then
! -- 評価 1 と同じ
tmp(i,j,k)=psi(i+1,j-1,k) +0.5*(bnd(i+1,j,k)*dy(j)-bnd(i,j-1,k)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j-1,k)==10)then
! -- 評価 2 と同じ
tmp(i,j,k)=psi(i-1,j+1,k) +0.5*(-bnd(i-1,j,k)*dy(j)+bnd(i,j+1,k)*dx(i))
end if
case (12) ! 両方フラックス一定で y 面の x, z 右上か左下角.
if(i==1.and.k==1)then ! -- 評価 1
tmp(i,j,k)=psi(i+1,j,k+1) -0.5*(bnd(i+1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
else if(i==nx.and.k==nz)then ! -- 評価 2
tmp(i,j,k)=psi(i-1,j,k-1) +0.5*(bnd(i-1,j,k)*dz(k)+bnd(i,j,k-1)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 1 と同じ
tmp(i,j,k)=psi(i+1,j,k+1) -0.5*(bnd(i+1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 2 と同じ
tmp(i,j,k)=psi(i-1,j,k-1) +0.5*(bnd(i-1,j,k)*dz(k)+bnd(i,j,k-1)*dx(i))
end if
case (-12) ! 両方フラックス一定で y 面の x, z 右下か左上角.
if(i==1.and.k==nz)then ! -- 評価 1
tmp(i,j,k)=psi(i+1,j,k-1) +0.5*(bnd(i+1,j,k)*dz(k)-bnd(i,j,k-1)*dx(i))
else if(i==nx.and.k==1)then ! -- 評価 2
tmp(i,j,k)=psi(i-1,j,k+1) +0.5*(-bnd(i-1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
else if(ib(i-1,j,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 1 と同じ
tmp(i,j,k)=psi(i+1,j,k-1) +0.5*(bnd(i+1,j,k)*dz(k)-bnd(i,j,k-1)*dx(i))
else if(ib(i+1,j,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 2 と同じ
tmp(i,j,k)=psi(i-1,j,k+1) +0.5*(-bnd(i-1,j,k)*dz(k)+bnd(i,j,k+1)*dx(i))
end if
case (24) ! 両方フラックス一定で x 面の y, z 右上か左下角.
if(j==1.and.k==1)then ! -- 評価 1
tmp(i,j,k)=psi(i,j+1,k+1) -0.5*(bnd(i,j+1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
else if(j==ny.and.k==nz)then ! -- 評価 2
tmp(i,j,k)=psi(i,j-1,k-1) +0.5*(bnd(i,j-1,k)*dz(k)+bnd(i,j,k-1)*dy(j))
else if(ib(i,j-1,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 1 と同じ
tmp(i,j,k)=psi(i,j+1,k+1) -0.5*(bnd(i,j+1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
else if(ib(i,j+1,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 2 と同じ
tmp(i,j,k)=psi(i,j-1,k-1) +0.5*(bnd(i,j-1,k)*dz(k)+bnd(i,j,k-1)*dy(j))
end if
case (-24) ! 両方フラックス一定で x 面の y, z 右下か左上角.
if(j==1.and.k==nz)then ! -- 評価 1
tmp(i,j,k)=psi(i,j+1,k-1) +0.5*(bnd(i,j+1,k)*dz(k)-bnd(i,j,k-1)*dy(j))
else if(j==ny.and.k==1)then ! -- 評価 2
tmp(i,j,k)=psi(i,j-1,k+1) +0.5*(-bnd(i,j-1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
else if(ib(i,j-1,k)==10.and.ib(i,j,k+1)==10)then
! -- 評価 1 と同じ
tmp(i,j,k)=psi(i,j+1,k-1) +0.5*(bnd(i,j+1,k)*dz(k)-bnd(i,j,k-1)*dy(j))
else if(ib(i,j+1,k)==10.and.ib(i,j,k-1)==10)then
! -- 評価 2 と同じ
tmp(i,j,k)=psi(i,j-1,k+1) +0.5*(-bnd(i,j-1,k)*dz(k)+bnd(i,j,k+1)*dy(j))
end if
!-- 以降, 隅領域なので, 個別に設定.
case (11) ! 両方フラックス一定で (1,1,1) 点, もしくは内部領域.
tmp(i,j,k)=psi(i+1,j+1,k+1) -(bnd(i,j+1,k+1)*dx(i) +bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j+1,k)*dz(k))/3.0
case (13) ! 両方フラックス一定で (nx,1,1) 点, もしくは内部領域.
tmp(i,j,k)=psi(i-1,j+1,k+1) -(-bnd(i,j+1,k+1)*dx(i) +bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j+1,k)*dz(k))/3.0
case (17) ! 両方フラックス一定で (1,ny,1) 点, もしくは内部領域.
tmp(i,j,k)=psi(i+1,j-1,k+1) -(bnd(i,j-1,k+1)*dx(i) -bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j-1,k)*dz(k))/3.0
case (19) ! 両方フラックス一定で (nx,ny,1) 点, もしくは内部領域.
tmp(i,j,k)=psi(i-1,j-1,k+1) -(-bnd(i,j-1,k+1)*dx(i) -bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j-1,k)*dz(k))/3.0
case (23) ! 両方フラックス一定で (1,1,nz) 点, もしくは内部領域.
tmp(i,j,k)=psi(i+1,j+1,k-1) -(bnd(i,j+1,k-1)*dx(i) +bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j+1,k)*dz(k))/3.0
case (29) ! 両方フラックス一定で (nx,1,nz) 点, もしくは内部領域.
tmp(i,j,k)=psi(i-1,j+1,k-1) -(-bnd(i,j+1,k-1)*dx(i) +bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j+1,k)*dz(k))/3.0
case (31) ! 両方フラックス一定で (1,ny,nz) 点, もしくは内部領域.
tmp(i,j,k)=psi(i+1,j-1,k-1) -(bnd(i,j-1,k-1)*dx(i) -bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j-1,k)*dz(k))/3.0
case (37) ! 両方フラックス一定で (nx,ny,nz) 点, もしくは内部領域.
tmp(i,j,k)=psi(i-1,j-1,k-1) -(-bnd(i,j-1,k-1)*dx(i) -bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j-1,k)*dz(k))/3.0
case (-11) ! 両方フラックス一定で (i+1,j+1,k+1) に 10 が設定.
tmp(i,j,k)=(psi(i-1,j+1,k+1)+psi(i+1,j-1,k+1)+psi(i+1,j+1,k-1) +bnd(i,j+1,k+1)*dx(i)+bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j+1,k)*dz(k))/3.0
case (-13) ! 両方フラックス一定で (i-1,j+1,k+1) に 10 が設定.
tmp(i,j,k)=(psi(i+1,j+1,k+1)+psi(i-1,j-1,k+1)+psi(i-1,j+1,k-1) -bnd(i,j+1,k+1)*dx(i)+bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j+1,k)*dz(k))/3.0
case (-17) ! 両方フラックス一定で (i+1,j-1,k+1) に 10 が設定.
tmp(i,j,k)=(psi(i-1,j-1,k+1)+psi(i+1,j+1,k+1)+psi(i+1,j-1,k-1) +bnd(i,j-1,k+1)*dx(i)-bnd(i+1,j,k+1)*dy(j) +bnd(i+1,j-1,k)*dz(k))/3.0
case (-19) ! 両方フラックス一定で (i-1,j-1,k+1) に 10 が設定.
tmp(i,j,k)=(psi(i+1,j-1,k+1)+psi(i-1,j+1,k+1)+psi(i-1,j-1,k-1) -bnd(i,j-1,k+1)*dx(i)-bnd(i-1,j,k+1)*dy(j) +bnd(i-1,j-1,k)*dz(k))/3.0
case (-23) ! 両方フラックス一定で (i+1,j+1,k-1) に 10 が設定.
tmp(i,j,k)=(psi(i-1,j+1,k-1)+psi(i+1,j-1,k-1)+psi(i+1,j+1,k+1) +bnd(i,j+1,k-1)*dx(i)+bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j+1,k)*dz(k))/3.0
case (-29) ! 両方フラックス一定で (i-1,j+1,k-1) に 10 が設定.
tmp(i,j,k)=(psi(i+1,j+1,k-1)+psi(i-1,j-1,k-1)+psi(i-1,j+1,k+1) -bnd(i,j+1,k-1)*dx(i)+bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j+1,k)*dz(k))/3.0
case (-31) ! 両方フラックス一定で (i+1,j-1,k-1) に 10 が設定.
tmp(i,j,k)=(psi(i-1,j-1,k-1)+psi(i+1,j+1,k-1)+psi(i+1,j-1,k+1) +bnd(i,j-1,k-1)*dx(i)-bnd(i+1,j,k-1)*dy(j) -bnd(i+1,j-1,k)*dz(k))/3.0
case (-37) ! 両方フラックス一定で (i-1,j-1,k-1) に 10 が設定.
tmp(i,j,k)=(psi(i+1,j-1,k-1)+psi(i-1,j+1,k-1)+psi(i-1,j-1,k+1) -bnd(i,j-1,k-1)*dx(i)-bnd(i-1,j,k-1)*dy(j) -bnd(i-1,j-1,k)*dz(k))/3.0
end select
end if
if(sor_flag.eqv..true.)then
tmp(i,j,k)=(1.0-accc)*psi(i,j,k)+tmp(i,j,k)*accc
end if
end do
end do
end do
!$omp end do
!$omp end parallel
!-- 最大誤差の更新
do k=2,nz-1
do j=2,ny-1
do i=2,nx-1
err=abs(tmp(i,j,k)-psi(i,j,k))
if(err_max<=err)then
err_max=err
end if
end do
end do
end do
!-- 一斉更新
do k=1,nz
do j=1,ny
do i=1,nx
psi(i,j,k)=tmp(i,j,k)
end do
end do
end do
end do
!-- 境界の設定
call calculate_bound_3d( ib, dx, dy, dz, bnd, psi )
!-- 未定義領域には undef を代入する.
do k=1,nz
do j=1,ny
do i=1,nx
if(ib(i,j,k)==10)then
psi(i,j,k)=defun
end if
end do
end do
end do
end subroutine Ellip_Jacobi_3d
| Subroutine : | |||
| coe(:,:) : | real, intent(inout)
| ||
| aval : | real, intent(in)
|
2 次元配列に aval が代入されていないかをチェックする.
subroutine check_coe( coe, aval )
! 2 次元配列に aval が代入されていないかをチェックする.
implicit none
real, intent(inout) :: coe(:,:) ! 代入される配列
real, intent(in) :: aval ! チェックされる値
integer :: i, j, nx, ny
nx=size(coe,1)
ny=size(coe,2)
do j=1,ny
do i=1,nx
if(coe(i,j)==aval)then
write(*,*) "### ERROR (Ellip_Slv module) ###"
write(*,*) "Detect a certain value", aval
write(*,*) "STOP."
stop
end if
end do
end do
end subroutine check_coe
| Subroutine : | |||
| coe(:,:,:) : | real, intent(inout)
| ||
| aval : | real, intent(in)
|
3 次元配列に aval で指定された値が入っていないかを検出する.
subroutine check_coe_3d( coe, aval )
! 3 次元配列に aval で指定された値が入っていないかを検出する.
implicit none
real, intent(inout) :: coe(:,:,:) ! 代入される配列
real, intent(in) :: aval ! 検出される値
integer :: i, j, k, nx, ny, nz
nx=size(coe,1)
ny=size(coe,2)
nz=size(coe,3)
do k=1,nz
do j=1,ny
do i=1,nx
if(coe(i,j,k)==aval)then
write(*,*) "### ERROR (Ellip_Slv module) ###"
write(*,*) "Detect a certain value", aval
write(*,*) "STOP."
stop
end if
end do
end do
end do
end subroutine check_coe_3d