Class | Alge_Solv |
In: |
alge_solv.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
|
ガウス=ザイデル法によるポアソン方程式の求積 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される. $$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} =rho $$ の各係数に対応している.
subroutine Poisson_GauSei(x, y, rho, eps, boundary, psi, bound_opt, a, b, c, d, e) ! ガウス=ザイデル法によるポアソン方程式の求積 ! 各オプション配列は, ポアソン系の各微分項の値. デフォルトはゼロで設定される. ! $$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} =\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(inout) :: psi(size(x),size(y)) ! ポアソン方程式の解 integer :: i, j, k, l, m, n integer :: nx ! x 方向の配列要素 integer :: ny ! y 方向の配列要素 integer :: signb, signd, signe ! 各係数を計算するかどうか real :: tmp, err, err_max 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 real, dimension(size(x),size(y)) :: adp, adm, cep, cem, ac character(4) :: bound real :: tmp_b, tmp_adm, tmp_adp, tmp_cem, tmp_cep bound(1:4)=boundary(1:4) nx=size(x) ny=size(y) psi = 0.0 !-- 周期境界の設定確認. !-- 周期境界なので, 両端とも 3 が設定されていないといけない. if(bound(1:1)=='3')then if(bound(3:3)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(1:1)==bound(3:3). STOP." stop end if end if if(bound(3:3)=='3')then if(bound(1:1)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(1:1)==bound(3:3). STOP." stop end if end if if(bound(2:2)=='3')then if(bound(4:4)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(2:2)==bound(4:4). STOP." stop end if end if if(bound(4:4)=='3')then if(bound(2:2)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(2:2)==bound(4:4). STOP." stop end if end if !-- 係数の代入 !-- a, c については, 値が入れられていなければ, 全配列に 1 を代入する. if(present(a))then do j=1,ny do i=1,nx at(i,j)=a(i,j) end do end do else do j=1,ny do i=1,nx at(i,j)=1.0 end do end do end if if(present(c))then do j=1,ny do i=1,nx ct(i,j)=c(i,j) end do end do else do j=1,ny do i=1,nx ct(i,j)=1.0 end do end do end if if(present(b))then do j=1,ny do i=1,nx bt(i,j)=b(i,j) end do end do signb=1 else signb=0 end if if(present(d))then do j=1,ny do i=1,nx dt(i,j)=d(i,j) end do end do signd=1 else signd=0 end if if(present(e))then do j=1,ny do i=1,nx et(i,j)=e(i,j) end do end do signe=1 else signe=0 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 !-- ポアソン係数の計算 if(signd==0)then ! 付加項 d がついていないとき do j=2,ny-1 do i=2,nx-1 adp(i,j)=at(i,j)/(dx2(i)) adm(i,j)=at(i,j)/(dx2(i)) end do end do else do j=2,ny-1 do i=2,nx-1 adp(i,j)=at(i,j)/(dx2(i))+0.5*dt(i,j)/dx(i) adm(i,j)=at(i,j)/(dx2(i))-0.5*dt(i,j)/dx(i) end do end do end if if(signe==0)then ! 付加項 e がついていないとき do j=2,ny-1 do i=2,nx-1 cep(i,j)=ct(i,j)/(dy2(j)) cem(i,j)=ct(i,j)/(dy2(j)) end do end do else do j=2,ny-1 do i=2,nx-1 cep(i,j)=ct(i,j)/(dy2(j))+0.5*et(i,j)/dy(j) cem(i,j)=ct(i,j)/(dy2(j))-0.5*et(i,j)/dy(j) end do end do end if !-- 最高次数係数 ac の計算 (境界条件によって評価式が変わる.) !-- 実際にポアソン係数が使用されるのは, 境界を除いた 1 回り内側なので, !-- 計算量削減のため, ループをそのようにしておく. do j=2,ny-1 ! 係数 ac については, 境界の内側で境界条件によって式が異なる. do i=2,nx-1 ! ここでは, 固定端条件での値を代入しており, それ以外の場合は以下の処理で上書きする. ac(i,j)=2.0*(at(i,j)/dx2(i)+ct(i,j)/dy2(j)) end do end do !-- 以下, 境界の内側での係数 ac の計算 !-- 本計算では, 固定境界があるなら, 隅領域はすべてその値で固定するようにしており, !-- 固定境界値は反復計算の前に与えられる値を用いるので, 境界条件 1 では評価式は変わらない. !-- また, 周期境界条件では, 両端が周期境界でなければならないから, bound の組み合わせは !-- 制限される. !-- 実際に係数が変わるのは, 条件 2 のときだけであるので, 2 について評価式を計算する. !-- (3 は係数ではなく, ポアソンの式だけが変化する.) !-- 以下では, 境界の 4 隅の内側も計算している. !-- これで 2 重勘定されるのは, 隅の両側ともが 2 の条件のときだけなので, !-- この方法を用いた方が場合分けが少なくて済む. !-- 2 重勘定したときは, その半分を引く. if(bound(1:1)=='2')then ! x 下端がノイマン条件 : psi(i,1)=psi(i,2)-f(i,1)*dy(1) do i=2,nx-1 ac(i,2)=ac(i,2)-cem(i,2) end do end if if(bound(2:2)=='2')then ! y 左端がノイマン条件 : psi(1,j)=psi(2,j)-f(1,j)*dx(1) do j=2,ny-1 ac(2,j)=ac(2,j)-adm(2,j) end do end if if(bound(3:3)=='2')then ! x 上端がノイマン条件 : psi(i,ny)=psi(i,ny-1)+f(i,ny)*dy(ny) do i=2,nx-1 ac(i,ny-1)=ac(i,ny-1)-cep(i,ny-1) end do end if if(bound(4:4)=='2')then ! y 右端がノイマン条件 : psi(nx,j)=psi(nx-1,j)+f(nx,j)*dx(nx) do j=2,ny-1 ac(nx-1,j)=ac(nx-1,j)-adp(nx-1,j) end do end if !-- 内側 4 隅での 2 重勘定の解消 bt についてはここでのみ計算されるので, 足し合わせておく. if(bound(1:2)=='22')then ! 左下隅の解消 ac(2,2)=ac(2,2)+(cem(2,2)+adm(2,2))*0.5-0.25*bt(2,2)/dxdy(2,2) end if if(bound(2:3)=='22')then ! 左上隅の解消 ac(2,ny-1)=ac(2,ny-1)+(cep(2,ny-1)+adm(2,ny-1))*0.5+0.25*bt(2,ny-1)/dxdy(2,ny-1) end if if(bound(3:4)=='22')then ! 右上隅の解消 ac(nx-1,ny-1)=ac(nx-1,ny-1)+(cep(nx-1,ny-1)+adp(nx-1,ny-1))*0.5 -0.25*bt(nx-1,ny-1)/dxdy(nx-1,ny-1) end if if(bound(1:1)=='2'.and.bound(4:4)=='2')then ! 右下隅の解消 ac(nx-1,2)=ac(nx-1,2)+(cem(nx-1,2)+adp(nx-1,2))*0.5+0.25*bt(nx-1,2)/dxdy(nx-1,2) end if !-- 境界値の設定 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 !-- 境界条件の確認 (+ 固定境界なら, その値を代入する.) if(bound(1:1)=='1')then do i=1,nx psi(i,1)=bnd(i,1) end do end if if(bound(2:2)=='1')then do j=1,ny psi(1,j)=bnd(1,j) end do end if if(bound(3:3)=='1')then do i=1,nx psi(i,ny)=bnd(i,ny) end do end if if(bound(4:4)=='1')then do j=1,ny psi(1,j)=bnd(1,j) end do end if 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=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) +adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1) -rho(i,j) if(signb==1)then tmp=tmp+0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) end if tmp=tmp/ac(i,j) else !-- 以下で境界の内側計算 !-- コードを見やすくするため, adm, adp, cem, cep の項ごとに case 分けする. if(i==2)then ! 左境界での扱い. ここでは, adm 以外の項は共通計算できる. if(j/=2.or.j/=ny-1)then ! 隅境界以外 tmp=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) +cem(i,j)*psi(i,j-1)-rho(i,j) select case (bound(2:2)) ! y 軸左端 case ('1') tmp_adm=adm(i,j)*psi(i-1,j) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('2') ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_adm=-adm(i,j)*bnd(i-1,j)*dx(i-1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) else tmp_b=0.0 end if case ('3') ! u(1,j)=u(nx-1,j) tmp_adm=adm(i,j)*psi(nx-1,j) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(nx-1,j-1) -psi(i+1,j-1)-psi(nx-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if end select tmp=(tmp+tmp_adm+tmp_b)/ac(i,j) else if(j==2)then ! 左下隅 ! adp, cep は境界条件に依存しない. tmp=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) -rho(i,j) select case (bound(1:1)) ! x 軸下端条件 -> cem 項の計算 case ('1') tmp_cem=cem(i,j)*psi(i,j-1) case ('2') ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_cem=-cem(i,j)*bnd(i,j-1)*dy(j-1) case ('3') ! u(i,1)=u(i,ny-1) tmp_cem=cem(i,j)*psi(i,ny-1) end select select case (bound(2:2)) case ('1') tmp_adm=adm(i,j)*psi(i-1,j) case ('2') ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_adm=-adm(i,j)*bnd(i-1,j)*dx(i-1) case ('3') ! u(1,j)=u(nx-1,j) tmp_adm=adm(i,j)*psi(nx-1,j) end select if(signb==1)then select case (bound(1:2)) case ('11') ! 両方固定境界 tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x 固定 y ノイマン ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1), j-1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('13') ! x 固定 y 周期 u(1,j)=u(nx-1,j) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(nx-1,j+1))/dxdy(i,j) case ('21') ! x ノイマン y 固定 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1)-psi(i-1,j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(i-1,j-1)=u(i,j)-0.5*(f(i-1,j)*dx(i-1)+f(i,j-1)*dy(j-1)) ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) -0.5*(bnd(i-1,j)*dx(i-1)+bnd(i,j-1)*dy(j-1)) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1) -psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('23') ! x ノイマン y 周期 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) ! u(1,1)=u(nx-1,1)=u(nx-1,2)-f(nx-1,1)*dy(1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) +psi(nx-1,2)-bnd(nx-1,1)*dy(1) -psi(i+1,j-1)-psi(nx-1,j+1))/dxdy(i,j) case ('31') ! x 周期 y 固定 u(i,j-1)=u(i,ny-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,ny-1)-psi(i-1,j+1))/dxdy(i,j) case ('32') ! x 周期 y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(1,1)=u(1,ny-1)=u(2,ny-1)-f(1,ny-1)*dx(1) ! u(i,j-1)=u(i,ny-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,ny-1)-bnd(i-1,ny-1)*dx(i-1) -psi(i+1,ny-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('33') ! x, y 周期 u(1,1)=u(nx-1,ny-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(nx-1,ny-1) -psi(i+1,ny-1)-psi(nx-1,j+1))/dxdy(i,j) end select else tmp_b=0.0 end if tmp=(tmp+tmp_adm+tmp_cem+tmp_b)/ac(i,j) else ! 左上隅 adp, cem は境界に関係なく求められる. tmp=adp(i,j)*psi(i+1,j)+cem(i,j)*psi(i,j-1) -rho(i,j) select case (bound(3:3)) ! x 軸上端条件 -> cep 項の計算 case ('1') tmp_cep=cep(i,j)*psi(i,j+1) case ('2') ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_cep=cep(i,j)*bnd(i,j+1)*dy(j+1) case ('3') ! u(i,ny)=u(i,2) tmp_cep=cep(i,j)*psi(i,2) end select select case (bound(2:2)) case ('1') tmp_adm=adm(i,j)*psi(i-1,j) case ('2') ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_adm=-adm(i,j)*bnd(i-1,j)*dx(i-1) case ('3') ! u(1,j)=u(nx-1,j) tmp_adm=adm(i,j)*psi(nx-1,j) end select if(signb==1)then select case (bound(2:3)) case ('11') ! 両方固定境界 tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x ノイマン y 固定 ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1), i-1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('13') ! x 周期 y 固定 u(i,ny)=u(i,2), i-1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,2)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('21') ! x 固定 y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! j+1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(i-1,j+1)=u(i,j)+0.5*(-f(i-1,j+1)*dx(i-1)+f(i-1,j+1)*dy(j+1)) ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_b=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1) +0.5*(bnd(i-1,j+1)*dx(i-1)-bnd(i-1,j+1)*dy(j+1)))/dxdy(i,j) case ('23') ! x 周期 y ノイマン u(i,ny)=u(i,2) ! u(1,ny)=u(1,2)=u(2,2)-f(1,2)*dx(1) ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_b=0.25*bt(i,j)*(psi(i+1,2) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1)-psi(2,2)+bnd(1,2)*dx(1))/dxdy(i,j) case ('31') ! x 固定 y 周期 u(1,j)=u(nx-1,j), j+1 は固定強制 tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(nx-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('32') ! x ノイマン y 周期 u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) ! u(1,ny)=u(nx-1,ny)=u(nx-1,ny-1)+f(nx-1,ny)*dy(ny) ! u(1,j)=u(nx-1,j) tmp_b=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(nx-1,j-1)-psi(i+1,j-1) -psi(nx-1,ny-1)-bnd(nx-1,ny)*dy(ny))/dxdy(i,j) case ('33') ! x, y 周期 u(1,ny)=u(nx-1,2) tmp_b=0.25*bt(i,j)*(psi(i+1,2)+psi(nx-1,j-1) -psi(i+1,j-1)-psi(nx-1,2))/dxdy(i,j) end select else tmp_b=0.0 end if tmp=(tmp+tmp_adm+tmp_cep+tmp_b)/ac(i,j) end if end if end if if(i==nx-1)then ! 右境界での扱い. ここでは, adp 以外の項は共通計算可能. if(j/=2.or.j/=ny-1)then ! 隅境界以外 tmp=cep(i,j)*psi(i,j+1) +adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1)-rho(i,j) select case (bound(4:4)) ! y 軸右端 case ('1') tmp_adp=adp(i,j)*psi(i+1,j) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('2') ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_adp=adp(i,j)*bnd(i+1,j)*dx(i+1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i,j+1)+bnd(i+1,j+1)*dx(i+1) +psi(i-1,j-1)-psi(i,j-1)-bnd(i+1,j-1)*dx(i+1) -psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('3') ! u(nx,j)=u(2,j) tmp_adp=adp(i,j)*psi(2,j) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(2,j+1)+psi(i-1,j-1) -psi(2,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if end select tmp=(tmp+tmp_adp+tmp_b)/ac(i,j) else if(j==2)then ! 右下隅 adm, cep は境界に関係なく求められる. tmp=adm(i,j)*psi(i-1,j)+cep(i,j)*psi(i,j+1) -rho(i,j) select case (bound(1:1)) ! x 軸下端条件 -> cem 項の計算 case ('1') tmp_cem=cem(i,j)*psi(i,j-1) case ('2') ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_cem=-cem(i,j)*bnd(i,j-1)*dy(j-1) case ('3') ! u(i,1)=u(i,ny-1) tmp_cem=cem(i,j)*psi(i,ny-1) end select select case (bound(4:4)) case ('1') tmp_adp=adp(i,j)*psi(i-1,j) case ('2') ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_adp=adp(i,j)*bnd(i+1,j)*dx(i+1) case ('3') ! u(nx,j)=u(2,j) tmp_adp=adp(i,j)*psi(2,j) end select if(signb==1)then select case (bound(1:1)//bound(4:4)) case ('11') ! 両方固定境界 tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x 固定 y ノイマン ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1), j-1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i,j+1)+bnd(i+1,j+1)*dx(i+1) +psi(i-1,j-1)-psi(i+1,j-1)-psi(i,j+1))/dxdy(i,j) case ('13') ! x 固定 y 周期 u(nx,j)=u(2,j) tmp_b=0.25*bt(i,j)*(psi(2,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('21') ! x ノイマン y 固定 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1)-psi(i-1,j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) ! u(i+1,j-1)=u(i,j)+0.5*(f(i+1,j)*dx(i+1)-f(i,j-1)*dy(j-1)) ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b=0.25*bt(i,j)*(psi(i,j+1)+bnd(i+1,j+1)*dx(i+1) -psi(i-1,j)+bnd(i-1,j-1)*dy(j-1) -0.5*(bnd(i+1,j)*dx(i+1)-bnd(i,j-1)*dy(j-1)) -psi(i-1,j+1))/dxdy(i,j) case ('23') ! x ノイマン y 周期 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) ! u(nx,1)=u(2,1)=u(2,2)-f(2,1)*dy(1) tmp_b=0.25*bt(i,j)*(psi(2,j+1) +psi(i-1,j)-bnd(i-1,j-1)*dy(j-1) -psi(2,2)+bnd(2,1)*dy(1)-psi(i-1,j+1))/dxdy(i,j) case ('31') ! x 周期 y 固定 u(i,j-1)=u(i,ny-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,ny-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('32') ! x 周期 y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(1,1)=u(1,ny-1)=u(2,ny-1)-f(1,ny-1)*dx(1) ! u(i,j-1)=u(i,ny-1) tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,ny-1)-bnd(i-1,ny-1)*dx(i-1) -psi(i+1,ny-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('33') ! x, y 周期 u(nx,1)=u(2,ny-1) tmp_b=0.25*bt(i,j)*(psi(2,j+1)+psi(i-1,ny-1) -psi(2,ny-1)-psi(i-1,j+1))/dxdy(i,j) end select else tmp_b=0.0 end if tmp=(tmp+tmp_adp+tmp_cem+tmp_b)/ac(i,j) else ! 右上隅 adm, cem は境界に関係なく求められる. tmp=adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1) -rho(i,j) select case (bound(3:3)) ! x 軸上端条件 -> cep 項の計算 case ('1') tmp_cep=cep(i,j)*psi(i,j+1) case ('2') ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_cep=cep(i,j)*bnd(i,j+1)*dy(j+1) case ('3') ! u(i,ny)=u(i,2) tmp_cep=cep(i,j)*psi(i,2) end select select case (bound(4:4)) case ('1') tmp_adp=adp(i,j)*psi(i-1,j) case ('2') ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_adp=adp(i,j)*bnd(i+1,j)*dx(i+1) case ('3') ! u(nx,j)=u(2,j) tmp_adp=adp(i,j)*psi(2,j) end select if(signb==1)then select case (bound(3:4)) case ('11') ! 両方固定境界 tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x 固定 y ノイマン u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) ! j+1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j)-bnd(i+1,j-1)*dx(i+1)-psi(i-1,j+1))/dxdy(i,j) case ('13') ! x 固定 y 周期 u(nx,j)=u(2,j), j+1 は固定強制 tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(2,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('21') ! x ノイマン y 固定 ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1), i+1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j)-bnd(i-1,j+1)*dy(j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) ! u(i+1,j+1)=u(i,j)+0.5*(f(i+1,j)*dx(i+1)+f(i,j+1)*dy(j+1)) ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_b=0.25*bt(i,j)*(0.5*(bnd(i+1,j)*dx(i+1) +bnd(i,j+1)*dy(j+1))+psi(i-1,j-1) -psi(i-1,j)-bnd(i-1,j+1)*dy(j+1) -psi(i,j-1)-bnd(i+1,j-1)*dx(i+1))/dxdy(i,j) case ('23') ! x ノイマン y 周期 u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) ! u(nx,ny)=u(2,ny)=u(2,ny-1)+f(2,ny)*dy(ny) ! u(nx,j)=u(2,j) tmp_b=0.25*bt(i,j)*(psi(2,ny-1)+bnd(2,ny)*dy(ny) +psi(i-1,j-1)-psi(2,j-1) -psi(i-1,j)-bnd(i-1,j+1)*dy(j+1))/dxdy(i,j) case ('31') ! x 周期 y 固定 u(i,ny)=u(i,2), i+1 は固定強制. tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,2))/dxdy(i,j) case ('32') ! x 周期 y ノイマン u(i,ny)=u(i,2) ! u(nx,ny)=u(nx,2)=u(nx-1,2)+f(nx,2)*dx(nx) ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_b=0.25*bt(i,j)*(psi(nx-1,2)+bnd(nx,2)*dx(nx) +psi(i-1,j-1)-psi(i,j-1)-bnd(i+1,j-1)*dx(i+1) -psi(i-1,2))/dxdy(i,j) case ('33') ! x, y 周期 u(nx,ny)=u(2,2) tmp_b=0.25*bt(i,j)*(psi(2,2)+psi(i-1,j-1) -psi(2,j-1)-psi(i-1,2))/dxdy(i,j) end select else tmp_b=0.0 end if tmp=(tmp+tmp_adp+tmp_cep+tmp_b)/ac(i,j) end if end if end if if(j==2)then ! 下境界での扱い. ここでは, cem 以外の項は共通計算できる. if(i/=2.or.i/=nx-1)then ! 隅境界以外 tmp=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) +adm(i,j)*psi(i-1,j)-rho(i,j) select case (bound(1:1)) ! x 軸下端 case ('1') tmp_cem=cem(i,j)*psi(i,j-1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('2') ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_cem=-cem(i,j)*bnd(i,j-1)*dy(j-1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i-1,j)-bnd(i-1,j-1)*dy(j-1) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('3') ! u(i,1)=u(i,ny-1) tmp_cem=cem(i,j)*psi(i,ny-1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,ny-1) -psi(i+1,ny-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if end select tmp=(tmp+tmp_cem+tmp_b)/ac(i,j) end if end if if(j==ny-1)then ! 上境界での扱い. ここでは, cep 以外の項は共通計算可能. if(i/=2.or.i/=nx-1)then ! 隅境界以外 tmp=adp(i,j)*psi(i+1,j) +adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1)-rho(i,j) select case (bound(3:3)) ! x 軸上端 case ('1') tmp_cep=cep(i,j)*psi(i,j+1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('2') ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_cep=cep(i,j)*bnd(i,j+1)*dy(j+1) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(i-1,j-i)-psi(i+1,j-1) -psi(i-1,j)-bnd(i-1,j+1)*dy(j+1))/dxdy(i,j) else tmp_b=0.0 end if case ('3') ! u(i,ny)=u(i,2) tmp_cep=cep(i,j)*psi(i,2) if(signb==1)then tmp_b=0.25*bt(i,j)*(psi(i+1,2)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,2))/dxdy(i,j) else tmp_b=0.0 end if end select tmp=(tmp+tmp_cep+tmp_b)/ac(i,j) end if end if end if !!-- ここまでは if 文のインデントを調節しない. ! end if ! ! tmp=tmp/ac(i,j) !-- 誤差の計算 --- ! if(psi(i,j)==0.0)then ! if(tmp==0.0)then ! err=0.0 ! else ! err=abs(tmp-psi(i,j))/abs(tmp) ! end if ! else ! if(abs(psi(i,j))<1.0.and.abs(tmp)<1.0)then ! err=abs(tmp-psi(i,j)) ! else ! err=abs(tmp-psi(i,j))/abs(psi(i,j)) ! end if ! end if err=abs(tmp-psi(i,j)) !-- 最大誤差の更新 if(err_max<=err)then err_max=err write(*,*) "### err", err_max, i, j, psi(i,j), tmp end if psi(i,j)=tmp end do end do !-- 境界の設定 !-- x 下端境界 select case (bound(1:1)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do i=2,nx-1 psi(i,1)=psi(i,2)-bnd(i,1)*dy(1) end do case ('3') do i=2,nx-1 psi(i,1)=psi(i,ny-1) end do end select !-- y 左端境界 select case (bound(2:2)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do j=2,ny-1 psi(1,j)=psi(2,j)-bnd(1,j)*dx(1) end do case ('3') do j=2,ny-1 psi(1,j)=psi(nx-1,j) end do end select !-- x 上端境界 select case (bound(3:3)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do i=2,nx-1 psi(i,ny)=psi(i,ny-1)+bnd(i,ny)*dy(ny) end do case ('3') do i=2,nx-1 psi(i,ny)=psi(i,2) end do end select !-- y 右端境界 select case (bound(4:4)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do j=2,ny-1 psi(nx,j)=psi(nx-1,j)+bnd(nx,j)*dx(nx) end do case ('3') do j=2,ny-1 psi(nx,j)=psi(2,j) end do end select !-- 4 端 ! 以下, 固定境界がどちらかにあるなら, その値に強制 ('11', '12,', '13', '21', '31') !-- また, bound(1:2) の値が分かれば, bound(3:4) の値も一意に決まる. !-- 片端のみ周期境界なら, 周期境界で値を更新し, そのあとにフラックスを流す順番にする. select case (bound(1:2)) case ('23') ! この場合は y 軸両端で周期境界なので, (1,1), (nx,1) の値がここで決まる. psi(1,1)=psi(nx-1,2)-bnd(nx-1,1)*dy(1) psi(nx,1)=psi(2,2)-bnd(2,1)*dy(1) if(bound(3:3)=='2')then ! x 軸上端が 1 ならすでに強制されているので, 何もしない. psi(1,ny)=psi(nx-1,ny-1)+bnd(nx-1,ny)*dy(ny) psi(nx,ny)=psi(2,ny-1)+bnd(2,ny)*dy(ny) end if case ('32') ! この場合は x 軸両端で周期境界なので, (1,1), (1,ny) の値がここで決まる. psi(1,1)=psi(2,ny-1)-bnd(1,ny-1)*dx(1) psi(1,ny)=psi(2,2)-bnd(1,2)*dx(1) if(bound(4:4)=='2')then ! y 軸右端が 1 ならすでに強制されているので, 何もしない. psi(nx,1)=psi(nx-1,ny-1)+bnd(nx,ny-1)*dx(nx) psi(nx,ny)=psi(nx-1,2)+bnd(nx,2)*dx(nx) end if case ('33') ! この場合は全領域周期境界 psi(1,1)=psi(nx-1,ny-1) psi(nx,1)=psi(2,ny-1) psi(1,ny)=psi(nx-1,2) psi(nx,ny)=psi(2,2) case default ! あとは, どの隅においても, '22' でなければ, 固定強制される. if(bound(1:2)=='22')then psi(1,1)=psi(2,2)-0.5*(bnd(1,2)*dy(1)+bnd(2,1)*dx(1)) end if if(bound(2:3)=='22')then psi(1,ny)=psi(2,ny-1)+0.5*(bnd(1,ny-1)*dy(ny)-bnd(2,ny)*dx(1)) end if if(bound(3:4)=='22')then psi(nx,ny)=psi(nx-1,ny-1)+0.5*(bnd(nx,ny-1)*dy(ny)+bnd(nx-1,ny)*dx(nx)) end if if(bound(1:1)=='2'.and.bound(4:4)=='2')then psi(nx,1)=psi(nx-1,2)+0.5*(-bnd(nx,2)*dy(1)+bnd(nx-1,1)*dx(nx)) end if end select end do end subroutine Poisson_GauSei
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
|
ヤコビ法によるポアソン方程式の求積(開発中openmp) openmp によるスレッド並列が可能. ガウス・ザイデル法ではアルゴリズムの点から並列化が困難と思われたので, 並列計算によるポアソン方程式の求積が必要となるなら, ヤコビ法のものを使用されたい.
subroutine Poisson_Jacobi(x, y, rho, eps, boundary, psi, bound_opt, a, b, c, d, e) ! ヤコビ法によるポアソン方程式の求積(開発中openmp) ! 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(inout) :: psi(size(x),size(y)) ! ポアソン方程式の解 integer :: i, j, k, l, m, n integer :: nx ! x 方向の配列要素 integer :: ny ! y 方向の配列要素 integer :: signb, signd, signe ! 各係数を計算するかどうか real :: err, err_max 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 real, dimension(size(x),size(y)) :: adp, adm, cep, cem, ac character(4) :: bound real, dimension(size(x),size(y)) :: tmp, tmp_b, tmp_adm, tmp_adp, tmp_cem, tmp_cep bound(1:4)=boundary(1:4) nx=size(x) ny=size(y) psi = 0.0 !-- 周期境界の設定確認. !-- 周期境界なので, 両端とも 3 が設定されていないといけない. if(bound(1:1)=='3')then if(bound(3:3)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(1:1)==bound(3:3). STOP." stop end if end if if(bound(3:3)=='3')then if(bound(1:1)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(1:1)==bound(3:3). STOP." stop end if end if if(bound(2:2)=='3')then if(bound(4:4)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(2:2)==bound(4:4). STOP." stop end if end if if(bound(4:4)=='3')then if(bound(2:2)/='3')then write(*,*) "### ERROR ###" write(*,*) "if bound = 3, bound(2:2)==bound(4:4). STOP." stop end if end if !-- 係数の代入 !-- a, c については, 値が入れられていなければ, 全配列に 1 を代入する. if(present(a))then do j=1,ny do i=1,nx at(i,j)=a(i,j) end do end do else do j=1,ny do i=1,nx at(i,j)=1.0 end do end do end if if(present(c))then do j=1,ny do i=1,nx ct(i,j)=c(i,j) end do end do else do j=1,ny do i=1,nx ct(i,j)=1.0 end do end do end if if(present(b))then do j=1,ny do i=1,nx bt(i,j)=b(i,j) end do end do signb=1 else signb=0 end if if(present(d))then do j=1,ny do i=1,nx dt(i,j)=d(i,j) end do end do signd=1 else signd=0 end if if(present(e))then do j=1,ny do i=1,nx et(i,j)=e(i,j) end do end do signe=1 else signe=0 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 !-- ポアソン係数の計算 if(signd==0)then ! 付加項 d がついていないとき do j=2,ny-1 do i=2,nx-1 adp(i,j)=at(i,j)/(dx2(i)) adm(i,j)=at(i,j)/(dx2(i)) end do end do else do j=2,ny-1 do i=2,nx-1 adp(i,j)=at(i,j)/(dx2(i))+0.5*dt(i,j)/dx(i) adm(i,j)=at(i,j)/(dx2(i))-0.5*dt(i,j)/dx(i) end do end do end if if(signe==0)then ! 付加項 e がついていないとき do j=2,ny-1 do i=2,nx-1 cep(i,j)=ct(i,j)/(dy2(j)) cem(i,j)=ct(i,j)/(dy2(j)) end do end do else do j=2,ny-1 do i=2,nx-1 cep(i,j)=ct(i,j)/(dy2(j))+0.5*et(i,j)/dy(j) cem(i,j)=ct(i,j)/(dy2(j))-0.5*et(i,j)/dy(j) end do end do end if !-- 最高次数係数 ac の計算 (境界条件によって評価式が変わる.) !-- 実際にポアソン係数が使用されるのは, 境界を除いた 1 回り内側なので, !-- 計算量削減のため, ループをそのようにしておく. do j=2,ny-1 ! 係数 ac については, 境界の内側で境界条件によって式が異なる. do i=2,nx-1 ! ここでは, 固定端条件での値を代入しており, それ以外の場合は以下の処理で上書きする. ac(i,j)=2.0*(at(i,j)/dx2(i)+ct(i,j)/dy2(j)) end do end do !-- 以下, 境界の内側での係数 ac の計算 !-- 本計算では, 固定境界があるなら, 隅領域はすべてその値で固定するようにしており, !-- 固定境界値は反復計算の前に与えられる値を用いるので, 境界条件 1 では評価式は変わらない. !-- また, 周期境界条件では, 両端が周期境界でなければならないから, bound の組み合わせは !-- 制限される. !-- 実際に係数が変わるのは, 条件 2 のときだけであるので, 2 について評価式を計算する. !-- (3 は係数ではなく, ポアソンの式だけが変化する.) !-- 以下では, 境界の 4 隅の内側も計算している. !-- これで 2 重勘定されるのは, 隅の両側ともが 2 の条件のときだけなので, !-- この方法を用いた方が場合分けが少なくて済む. !-- 2 重勘定したときは, その半分を引く. if(bound(1:1)=='2')then ! x 下端がノイマン条件 : psi(i,1)=psi(i,2)-f(i,1)*dy(1) do i=2,nx-1 ac(i,2)=ac(i,2)-cem(i,2) end do end if if(bound(2:2)=='2')then ! y 左端がノイマン条件 : psi(1,j)=psi(2,j)-f(1,j)*dx(1) do j=2,ny-1 ac(2,j)=ac(2,j)-adm(2,j) end do end if if(bound(3:3)=='2')then ! x 上端がノイマン条件 : psi(i,ny)=psi(i,ny-1)+f(i,ny)*dy(ny) do i=2,nx-1 ac(i,ny-1)=ac(i,ny-1)-cep(i,ny-1) end do end if if(bound(4:4)=='2')then ! y 右端がノイマン条件 : psi(nx,j)=psi(nx-1,j)+f(nx,j)*dx(nx) do j=2,ny-1 ac(nx-1,j)=ac(nx-1,j)-adp(nx-1,j) end do end if !-- 内側 4 隅での 2 重勘定の解消 bt についてはここでのみ計算されるので, 足し合わせておく. if(bound(1:2)=='22')then ! 左下隅の解消 ac(2,2)=ac(2,2)+(cem(2,2)+adm(2,2))*0.5-0.25*bt(2,2)/dxdy(2,2) end if if(bound(2:3)=='22')then ! 左上隅の解消 ac(2,ny-1)=ac(2,ny-1)+(cep(2,ny-1)+adm(2,ny-1))*0.5+0.25*bt(2,ny-1)/dxdy(2,ny-1) end if if(bound(3:4)=='22')then ! 右上隅の解消 ac(nx-1,ny-1)=ac(nx-1,ny-1)+(cep(nx-1,ny-1)+adp(nx-1,ny-1))*0.5 -0.25*bt(nx-1,ny-1)/dxdy(nx-1,ny-1) end if if(bound(1:1)=='2'.and.bound(4:4)=='2')then ! 右下隅の解消 ac(nx-1,2)=ac(nx-1,2)+(cem(nx-1,2)+adp(nx-1,2))*0.5+0.25*bt(nx-1,2)/dxdy(nx-1,2) end if !-- 境界値の設定 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 !-- 境界条件の確認 (+ 固定境界なら, その値を代入する.) if(bound(1:1)=='1')then do i=1,nx psi(i,1)=bnd(i,1) end do end if if(bound(2:2)=='1')then do j=1,ny psi(1,j)=bnd(1,j) end do end if if(bound(3:3)=='1')then do i=1,nx psi(i,ny)=bnd(i,ny) end do end if if(bound(4:4)=='1')then do j=1,ny psi(1,j)=bnd(1,j) end do end if err_max=eps ! while に入るための便宜的措置 !-- 実際のソルバ --- do while(err_max>=eps) err_max=0.0 !$omp parallel default(shared) !$omp do 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)=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) +adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1) -rho(i,j) if(signb==1)then tmp(i,j)=tmp(i,j)+0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) end if tmp(i,j)=tmp(i,j)/ac(i,j) else !-- 以下で境界の内側計算 !-- コードを見やすくするため, adm, adp, cem, cep の項ごとに case 分けする. if(i==2)then ! 左境界での扱い. ここでは, adm 以外の項は共通計算できる. if(j/=2.or.j/=ny-1)then ! 隅境界以外 tmp(i,j)=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) +cem(i,j)*psi(i,j-1)-rho(i,j) select case (bound(2:2)) ! y 軸左端 case ('1') tmp_adm(i,j)=adm(i,j)*psi(i-1,j) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('2') ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_adm(i,j)=-adm(i,j)*bnd(i-1,j)*dx(i-1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('3') ! u(1,j)=u(nx-1,j) tmp_adm(i,j)=adm(i,j)*psi(nx-1,j) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(nx-1,j-1) -psi(i+1,j-1)-psi(nx-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if end select tmp(i,j)=(tmp(i,j)+tmp_adm(i,j)+tmp_b(i,j))/ac(i,j) else if(j==2)then ! 左下隅 ! adp, cep は境界条件に依存しない. tmp(i,j)=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) -rho(i,j) select case (bound(1:1)) ! x 軸下端条件 -> cem 項の計算 case ('1') tmp_cem(i,j)=cem(i,j)*psi(i,j-1) case ('2') ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_cem(i,j)=-cem(i,j)*bnd(i,j-1)*dy(j-1) case ('3') ! u(i,1)=u(i,ny-1) tmp_cem(i,j)=cem(i,j)*psi(i,ny-1) end select select case (bound(2:2)) case ('1') tmp_adm(i,j)=adm(i,j)*psi(i-1,j) case ('2') ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_adm(i,j)=-adm(i,j)*bnd(i-1,j)*dx(i-1) case ('3') ! u(1,j)=u(nx-1,j) tmp_adm(i,j)=adm(i,j)*psi(nx-1,j) end select if(signb==1)then select case (bound(1:2)) case ('11') ! 両方固定境界 tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x 固定 y ノイマン ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1), j-1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('13') ! x 固定 y 周期 u(1,j)=u(nx-1,j) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(nx-1,j+1))/dxdy(i,j) case ('21') ! x ノイマン y 固定 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1)-psi(i-1,j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(i-1,j-1)=u(i,j)-0.5*(f(i-1,j)*dx(i-1)+f(i,j-1)*dy(j-1)) ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) -0.5*(bnd(i-1,j)*dx(i-1)+bnd(i,j-1)*dy(j-1)) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1) -psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('23') ! x ノイマン y 周期 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) ! u(1,1)=u(nx-1,1)=u(nx-1,2)-f(nx-1,1)*dy(1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) +psi(nx-1,2)-bnd(nx-1,1)*dy(1) -psi(i+1,j-1)-psi(nx-1,j+1))/dxdy(i,j) case ('31') ! x 周期 y 固定 u(i,j-1)=u(i,ny-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,ny-1)-psi(i-1,j+1))/dxdy(i,j) case ('32') ! x 周期 y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(1,1)=u(1,ny-1)=u(2,ny-1)-f(1,ny-1)*dx(1) ! u(i,j-1)=u(i,ny-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,ny-1)-bnd(i-1,ny-1)*dx(i-1) -psi(i+1,ny-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('33') ! x, y 周期 u(1,1)=u(nx-1,ny-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(nx-1,ny-1) -psi(i+1,ny-1)-psi(nx-1,j+1))/dxdy(i,j) end select else tmp_b(i,j)=0.0 end if tmp(i,j)=(tmp(i,j)+tmp_adm(i,j)+tmp_cem(i,j)+tmp_b(i,j))/ac(i,j) else ! 左上隅 adp, cem は境界に関係なく求められる. tmp(i,j)=adp(i,j)*psi(i+1,j)+cem(i,j)*psi(i,j-1) -rho(i,j) select case (bound(3:3)) ! x 軸上端条件 -> cep 項の計算 case ('1') tmp_cep(i,j)=cep(i,j)*psi(i,j+1) case ('2') ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_cep(i,j)=cep(i,j)*bnd(i,j+1)*dy(j+1) case ('3') ! u(i,ny)=u(i,2) tmp_cep(i,j)=cep(i,j)*psi(i,2) end select select case (bound(2:2)) case ('1') tmp_adm(i,j)=adm(i,j)*psi(i-1,j) case ('2') ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_adm(i,j)=-adm(i,j)*bnd(i-1,j)*dx(i-1) case ('3') ! u(1,j)=u(nx-1,j) tmp_adm(i,j)=adm(i,j)*psi(nx-1,j) end select if(signb==1)then select case (bound(2:3)) case ('11') ! 両方固定境界 tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x ノイマン y 固定 ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1), i-1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('13') ! x 周期 y 固定 u(i,ny)=u(i,2), i-1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,2)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('21') ! x 固定 y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! j+1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(i-1,j+1)=u(i,j)+0.5*(-f(i-1,j+1)*dx(i-1)+f(i-1,j+1)*dy(j+1)) ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1) +0.5*(bnd(i-1,j+1)*dx(i-1)-bnd(i-1,j+1)*dy(j+1)))/dxdy(i,j) case ('23') ! x 周期 y ノイマン u(i,ny)=u(i,2) ! u(1,ny)=u(1,2)=u(2,2)-f(1,2)*dx(1) ! u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,2) +psi(i,j-1)-bnd(i-1,j-1)*dx(i-1) -psi(i+1,j-1)-psi(2,2)+bnd(1,2)*dx(1))/dxdy(i,j) case ('31') ! x 固定 y 周期 u(1,j)=u(nx-1,j), j+1 は固定強制 tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(nx-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('32') ! x ノイマン y 周期 u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) ! u(1,ny)=u(nx-1,ny)=u(nx-1,ny-1)+f(nx-1,ny)*dy(ny) ! u(1,j)=u(nx-1,j) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(nx-1,j-1)-psi(i+1,j-1) -psi(nx-1,ny-1)-bnd(nx-1,ny)*dy(ny))/dxdy(i,j) case ('33') ! x, y 周期 u(1,ny)=u(nx-1,2) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,2)+psi(nx-1,j-1) -psi(i+1,j-1)-psi(nx-1,2))/dxdy(i,j) end select else tmp_b(i,j)=0.0 end if tmp(i,j)=(tmp(i,j)+tmp_adm(i,j)+tmp_cep(i,j)+tmp_b(i,j))/ac(i,j) end if end if end if if(i==nx-1)then ! 右境界での扱い. ここでは, adp 以外の項は共通計算可能. if(j/=2.or.j/=ny-1)then ! 隅境界以外 tmp(i,j)=cep(i,j)*psi(i,j+1) +adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1)-rho(i,j) select case (bound(4:4)) ! y 軸右端 case ('1') tmp_adp(i,j)=adp(i,j)*psi(i+1,j) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('2') ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_adp(i,j)=adp(i,j)*bnd(i+1,j)*dx(i+1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i,j+1)+bnd(i+1,j+1)*dx(i+1) +psi(i-1,j-1)-psi(i,j-1)-bnd(i+1,j-1)*dx(i+1) -psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('3') ! u(nx,j)=u(2,j) tmp_adp(i,j)=adp(i,j)*psi(2,j) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(2,j+1)+psi(i-1,j-1) -psi(2,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if end select tmp(i,j)=(tmp(i,j)+tmp_adp(i,j)+tmp_b(i,j))/ac(i,j) else if(j==2)then ! 右下隅 adm, cep は境界に関係なく求められる. tmp(i,j)=adm(i,j)*psi(i-1,j)+cep(i,j)*psi(i,j+1) -rho(i,j) select case (bound(1:1)) ! x 軸下端条件 -> cem 項の計算 case ('1') tmp_cem(i,j)=cem(i,j)*psi(i,j-1) case ('2') ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_cem(i,j)=-cem(i,j)*bnd(i,j-1)*dy(j-1) case ('3') ! u(i,1)=u(i,ny-1) tmp_cem(i,j)=cem(i,j)*psi(i,ny-1) end select select case (bound(4:4)) case ('1') tmp_adp(i,j)=adp(i,j)*psi(i-1,j) case ('2') ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_adp(i,j)=adp(i,j)*bnd(i+1,j)*dx(i+1) case ('3') ! u(nx,j)=u(2,j) tmp_adp(i,j)=adp(i,j)*psi(2,j) end select if(signb==1)then select case (bound(1:1)//bound(4:4)) case ('11') ! 両方固定境界 tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x 固定 y ノイマン ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1), j-1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i,j+1)+bnd(i+1,j+1)*dx(i+1) +psi(i-1,j-1)-psi(i+1,j-1)-psi(i,j+1))/dxdy(i,j) case ('13') ! x 固定 y 周期 u(nx,j)=u(2,j) tmp_b(i,j)=0.25*bt(i,j)*(psi(2,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('21') ! x ノイマン y 固定 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1)-psi(i-1,j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) ! u(i+1,j-1)=u(i,j)+0.5*(f(i+1,j)*dx(i+1)-f(i,j-1)*dy(j-1)) ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i,j+1)+bnd(i+1,j+1)*dx(i+1) -psi(i-1,j)+bnd(i-1,j-1)*dy(j-1) -0.5*(bnd(i+1,j)*dx(i+1)-bnd(i,j-1)*dy(j-1)) -psi(i-1,j+1))/dxdy(i,j) case ('23') ! x ノイマン y 周期 u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) ! u(nx,1)=u(2,1)=u(2,2)-f(2,1)*dy(1) tmp_b(i,j)=0.25*bt(i,j)*(psi(2,j+1) +psi(i-1,j)-bnd(i-1,j-1)*dy(j-1) -psi(2,2)+bnd(2,1)*dy(1)-psi(i-1,j+1))/dxdy(i,j) case ('31') ! x 周期 y 固定 u(i,j-1)=u(i,ny-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,ny-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('32') ! x 周期 y ノイマン u(i-1,j)=u(i,j)-f(i-1,j)*dx(i-1) ! u(1,1)=u(1,ny-1)=u(2,ny-1)-f(1,ny-1)*dx(1) ! u(i,j-1)=u(i,ny-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i,ny-1)-bnd(i-1,ny-1)*dx(i-1) -psi(i+1,ny-1)-psi(i,j+1)+bnd(i-1,j+1)*dx(i-1))/dxdy(i,j) case ('33') ! x, y 周期 u(nx,1)=u(2,ny-1) tmp_b(i,j)=0.25*bt(i,j)*(psi(2,j+1)+psi(i-1,ny-1) -psi(2,ny-1)-psi(i-1,j+1))/dxdy(i,j) end select else tmp_b(i,j)=0.0 end if tmp(i,j)=(tmp(i,j)+tmp_adp(i,j)+tmp_cem(i,j)+tmp_b(i,j))/ac(i,j) else ! 右上隅 adm, cem は境界に関係なく求められる. tmp(i,j)=adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1) -rho(i,j) select case (bound(3:3)) ! x 軸上端条件 -> cep 項の計算 case ('1') tmp_cep(i,j)=cep(i,j)*psi(i,j+1) case ('2') ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_cep(i,j)=cep(i,j)*bnd(i,j+1)*dy(j+1) case ('3') ! u(i,ny)=u(i,2) tmp_cep(i,j)=cep(i,j)*psi(i,2) end select select case (bound(4:4)) case ('1') tmp_adp(i,j)=adp(i,j)*psi(i-1,j) case ('2') ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_adp(i,j)=adp(i,j)*bnd(i+1,j)*dx(i+1) case ('3') ! u(nx,j)=u(2,j) tmp_adp(i,j)=adp(i,j)*psi(2,j) end select if(signb==1)then select case (bound(3:4)) case ('11') ! 両方固定境界 tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('12') ! x 固定 y ノイマン u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) ! j+1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j)-bnd(i+1,j-1)*dx(i+1)-psi(i-1,j+1))/dxdy(i,j) case ('13') ! x 固定 y 周期 u(nx,j)=u(2,j), j+1 は固定強制 tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(2,j-1)-psi(i-1,j+1))/dxdy(i,j) case ('21') ! x ノイマン y 固定 ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1), i+1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j)-bnd(i-1,j+1)*dy(j+1))/dxdy(i,j) case ('22') ! x, y ノイマン u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) ! u(i+1,j+1)=u(i,j)+0.5*(f(i+1,j)*dx(i+1)+f(i,j+1)*dy(j+1)) ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_b(i,j)=0.25*bt(i,j)*(0.5*(bnd(i+1,j)*dx(i+1) +bnd(i,j+1)*dy(j+1))+psi(i-1,j-1) -psi(i-1,j)-bnd(i-1,j+1)*dy(j+1) -psi(i,j-1)-bnd(i+1,j-1)*dx(i+1))/dxdy(i,j) case ('23') ! x ノイマン y 周期 u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) ! u(nx,ny)=u(2,ny)=u(2,ny-1)+f(2,ny)*dy(ny) ! u(nx,j)=u(2,j) tmp_b(i,j)=0.25*bt(i,j)*(psi(2,ny-1)+bnd(2,ny)*dy(ny) +psi(i-1,j-1)-psi(2,j-1) -psi(i-1,j)-bnd(i-1,j+1)*dy(j+1))/dxdy(i,j) case ('31') ! x 周期 y 固定 u(i,ny)=u(i,2), i+1 は固定強制. tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,2))/dxdy(i,j) case ('32') ! x 周期 y ノイマン u(i,ny)=u(i,2) ! u(nx,ny)=u(nx,2)=u(nx-1,2)+f(nx,2)*dx(nx) ! u(i+1,j)=u(i,j)+f(i+1,j)*dx(i+1) tmp_b(i,j)=0.25*bt(i,j)*(psi(nx-1,2)+bnd(nx,2)*dx(nx) +psi(i-1,j-1)-psi(i,j-1)-bnd(i+1,j-1)*dx(i+1) -psi(i-1,2))/dxdy(i,j) case ('33') ! x, y 周期 u(nx,ny)=u(2,2) tmp_b(i,j)=0.25*bt(i,j)*(psi(2,2)+psi(i-1,j-1) -psi(2,j-1)-psi(i-1,2))/dxdy(i,j) end select else tmp_b(i,j)=0.0 end if tmp(i,j)=(tmp(i,j)+tmp_adp(i,j)+tmp_cep(i,j)+tmp_b(i,j))/ac(i,j) end if end if end if if(j==2)then ! 下境界での扱い. ここでは, cem 以外の項は共通計算できる. if(i/=2.or.i/=nx-1)then ! 隅境界以外 tmp(i,j)=adp(i,j)*psi(i+1,j)+cep(i,j)*psi(i,j+1) +adm(i,j)*psi(i-1,j)-rho(i,j) select case (bound(1:1)) ! x 軸下端 case ('1') tmp_cem(i,j)=cem(i,j)*psi(i,j-1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('2') ! u(i,j-1)=u(i,j)-f(i,j-1)*dy(j-1) tmp_cem(i,j)=-cem(i,j)*bnd(i,j-1)*dy(j-1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1) +psi(i-1,j)-bnd(i-1,j-1)*dy(j-1) -psi(i+1,j)+bnd(i+1,j-1)*dy(j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('3') ! u(i,1)=u(i,ny-1) tmp_cem(i,j)=cem(i,j)*psi(i,ny-1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,ny-1) -psi(i+1,ny-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if end select tmp(i,j)=(tmp(i,j)+tmp_cem(i,j)+tmp_b(i,j))/ac(i,j) end if end if if(j==ny-1)then ! 上境界での扱い. ここでは, cep 以外の項は共通計算可能. if(i/=2.or.i/=nx-1)then ! 隅境界以外 tmp(i,j)=adp(i,j)*psi(i+1,j) +adm(i,j)*psi(i-1,j)+cem(i,j)*psi(i,j-1)-rho(i,j) select case (bound(3:3)) ! x 軸上端 case ('1') tmp_cep(i,j)=cep(i,j)*psi(i,j+1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j+1)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('2') ! u(i,j+1)=u(i,j)+f(i,j+1)*dy(j+1) tmp_cep(i,j)=cep(i,j)*bnd(i,j+1)*dy(j+1) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,j)+bnd(i+1,j+1)*dy(j+1) +psi(i-1,j-i)-psi(i+1,j-1) -psi(i-1,j)-bnd(i-1,j+1)*dy(j+1))/dxdy(i,j) else tmp_b(i,j)=0.0 end if case ('3') ! u(i,ny)=u(i,2) tmp_cep(i,j)=cep(i,j)*psi(i,2) if(signb==1)then tmp_b(i,j)=0.25*bt(i,j)*(psi(i+1,2)+psi(i-1,j-1) -psi(i+1,j-1)-psi(i-1,2))/dxdy(i,j) else tmp_b(i,j)=0.0 end if end select tmp(i,j)=(tmp(i,j)+tmp_cep(i,j)+tmp_b(i,j))/ac(i,j) end if end if 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 ! 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 err=abs(tmp(i,j)-psi(i,j)) !-- 最大誤差の更新 if(err_max<=err)then err_max=err end if end do end do do j=2,ny-1 do i=2,nx-1 psi(i,j)=tmp(i,j) end do end do !-- 境界の設定 !-- x 下端境界 select case (bound(1:1)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do i=2,nx-1 psi(i,1)=psi(i,2)-bnd(i,1)*dy(1) end do case ('3') do i=2,nx-1 psi(i,1)=psi(i,ny-1) end do end select !-- y 左端境界 select case (bound(2:2)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do j=2,ny-1 psi(1,j)=psi(2,j)-bnd(1,j)*dx(1) end do case ('3') do j=2,ny-1 psi(1,j)=psi(nx-1,j) end do end select !-- x 上端境界 select case (bound(3:3)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do i=2,nx-1 psi(i,ny)=psi(i,ny-1)+bnd(i,ny)*dy(ny) end do case ('3') do i=2,nx-1 psi(i,ny)=psi(i,2) end do end select !-- y 右端境界 select case (bound(4:4)) ! bound = 1 は境界での更新がないので, 場合分けしない. case ('2') do j=2,ny-1 psi(nx,j)=psi(nx-1,j)+bnd(nx,j)*dx(nx) end do case ('3') do j=2,ny-1 psi(nx,j)=psi(2,j) end do end select !-- 4 端 ! 以下, 固定境界がどちらかにあるなら, その値に強制 ('11', '12,', '13', '21', '31') !-- また, bound(1:2) の値が分かれば, bound(3:4) の値も一意に決まる. !-- 片端のみ周期境界なら, 周期境界で値を更新し, そのあとにフラックスを流す順番にする. select case (bound(1:2)) case ('23') ! この場合は y 軸両端で周期境界なので, (1,1), (nx,1) の値がここで決まる. psi(1,1)=psi(nx-1,2)-bnd(nx-1,1)*dy(1) psi(nx,1)=psi(2,2)-bnd(2,1)*dy(1) if(bound(3:3)=='2')then ! x 軸上端が 1 ならすでに強制されているので, 何もしない. psi(1,ny)=psi(nx-1,ny-1)+bnd(nx-1,ny)*dy(ny) psi(nx,ny)=psi(2,ny-1)+bnd(2,ny)*dy(ny) end if case ('32') ! この場合は x 軸両端で周期境界なので, (1,1), (1,ny) の値がここで決まる. psi(1,1)=psi(2,ny-1)-bnd(1,ny-1)*dx(1) psi(1,ny)=psi(2,2)-bnd(1,2)*dx(1) if(bound(4:4)=='2')then ! y 軸右端が 1 ならすでに強制されているので, 何もしない. psi(nx,1)=psi(nx-1,ny-1)+bnd(nx,ny-1)*dx(nx) psi(nx,ny)=psi(nx-1,2)+bnd(nx,2)*dx(nx) end if case ('33') ! この場合は全領域周期境界 psi(1,1)=psi(nx-1,ny-1) psi(nx,1)=psi(2,ny-1) psi(1,ny)=psi(nx-1,2) psi(nx,ny)=psi(2,2) case default ! あとは, どの隅においても, '22' でなければ, 固定強制される. if(bound(1:2)=='22')then psi(1,1)=psi(2,2)-0.5*(bnd(1,2)*dy(1)+bnd(2,1)*dx(1)) end if if(bound(2:3)=='22')then psi(1,ny)=psi(2,ny-1)+0.5*(bnd(1,ny-1)*dy(ny)-bnd(2,ny)*dx(1)) end if if(bound(3:4)=='22')then psi(nx,ny)=psi(nx-1,ny-1)+0.5*(bnd(nx,ny-1)*dy(ny)+bnd(nx-1,ny)*dx(nx)) end if if(bound(1:1)=='2'.and.bound(4:4)=='2')then psi(nx,1)=psi(nx-1,2)+0.5*(-bnd(nx,2)*dy(1)+bnd(nx-1,1)*dx(nx)) end if end select end do end subroutine Poisson_Jacobi