任意の物理量を台風の中心から接線方向へ平均するルーチン 接線風速平均用.
引数の制限として, |x(1)-xc|, |xc-x(nx)|, |y(1)-yc|, |yc-y(ny)| > r.
平均化の手順は以下のとおり. (1) nr, nt のすべての点についてそれに対応する
x, y 座標値を rt_2_xy で計算. (2) その地点を含む x,y グリッドの微小領域を
interpo_search_2d で検索. (3) その地点を含む 4 点が出たら,
その地点でのスカラー値を 4 隅のスカラー値
(4) nr x nt 個の内挿接線成分値が求まったら, nt 方向に平均計算 mean_1d 使用.
以上で各 nr について平均値が得られる.
subroutine tangent_mean_vec( charc, x, y, xc, yc, u1, u2, r, theta, v )
! 任意の物理量を台風の中心から接線方向へ平均するルーチン
! 接線風速平均用.
! 引数の制限として, |x(1)-xc|, |xc-x(nx)|, |y(1)-yc|, |yc-y(ny)| > r.
! 平均化の手順は以下のとおり.
! (1) nr, nt のすべての点についてそれに対応する x, y 座標値を rt_2_xy で計算.
! (2) その地点を含む x,y グリッドの微小領域を interpo_search_2d で検索.
! (3) その地点を含む 4 点が出たら, その地点でのスカラー値を 4 隅のスカラー値
! から, 重線形内挿 interpolation_2d で計算.
! これと同じループ内で, 2 つのベクトル成分の平均値が得られるので,
! これらを用いて vec_prod によって中心からの位置ベクトルとの外積を計算
! . 同じループ内で中心からの距離で割って v の接線成分のみ抽出.
! (4) nr x nt 個の内挿接線成分値が求まったら, nt 方向に平均計算 mean_1d 使用.
! 以上で各 nr について平均値が得られる.
use analy
use max_min
use statistics
use Geometry
implicit none
character(6), intent(in) :: charc ! 動径成分か接線成分かの判別, vector = 接線, scalar = 動径成分.
real, intent(in) :: x(:) ! デカルト座標系での x 座標
real, intent(in) :: y(:) ! デカルト座標系での y 座標
real, intent(in) :: u1(size(x),size(y)) ! デカルト座標系での平均化する値 1
real, intent(in) :: u2(size(x),size(y)) ! デカルト座標系での平均化する値 2
real, intent(in) :: xc ! 接線平均する際の中心 x 成分.
real, intent(in) :: yc ! 接線平均する際の中心 y 成分.
real, intent(in) :: r(:) ! 平均化したときの動径方向の座標(xc からの値を入れる).
real, intent(in) :: theta(:) ! 平均化するときの接線方向の座標 [rad].
real, intent(inout) :: v(size(r)) ! 平均化した u の値.
integer :: i, j, k, nx, ny, nr, nt
real :: work1(size(r),size(theta)), work2(size(r),size(theta)), work3(size(r),size(theta))
real :: posx(size(r),size(theta)), posy(size(r),size(theta)), posz(size(r),size(theta))
real :: vecx(size(r),size(theta)), vecy(size(r),size(theta)), vecz(size(r),size(theta))
real :: abpos(size(r),size(theta))
real :: point(size(r),size(theta),2)
integer :: ip(size(r),size(theta),2)
real :: tmpx(2), tmpy(2), tmpz(2,2), inter(2)
nx=size(x)
ny=size(y)
nr=size(r)
nt=size(theta)
!-- 先の引数条件をクリアしているか確認 ---
if(abs(x(1)-xc) < r(nt))then
write(*,*) "error : |x(1)-xc| >= rmax. "
stop
else
if(abs(x(nx)-xc) < r(nt))then
write(*,*) "error : |x(nx)-xc| >= rmax. "
stop
else
if(abs(y(1)-yc) < r(nt))then
write(*,*) "error : |y(1)-yc| >= rmax. "
stop
else
if(abs(y(ny)-yc) < r(nt))then
write(*,*) "error : |y(ny)-yc| >= rmax. "
stop
end if
end if
end if
end if
!-- 過程(1) ---
do j=1,nt
do i=1,nr
call rt_2_xy( r(i), theta(j), point(i,j,1), point(i,j,2) )
point(i,j,1)=xc+point(i,j,1)
point(i,j,2)=yc+point(i,j,2)
end do
end do
!-- 過程(2) ---
do j=1,nt
do i=1,nr
call interpo_search_2d( x, y, point(i,j,1), point(i,j,2), ip(i,j,1), ip(i,j,2) )
end do
end do
!-- 過程(3) ---
!-- 1. ベクトルの 2 成分について内挿した値を配列に格納 ---
do j=1,nt
do i=1,nr
tmpx(1)=x(ip(i,j,1))
tmpx(2)=x(ip(i,j,1)+1)
tmpy(1)=y(ip(i,j,2))
tmpy(2)=y(ip(i,j,2)+1)
tmpz(1,1)=u1(ip(i,j,1),ip(i,j,2))
tmpz(2,1)=u1(ip(i,j,1)+1,ip(i,j,2))
tmpz(1,2)=u1(ip(i,j,1),ip(i,j,2)+1)
tmpz(2,2)=u1(ip(i,j,1)+1,ip(i,j,2)+1)
inter(1)=point(i,j,1)
inter(2)=point(i,j,2)
call interpolation_2d( tmpx, tmpy, tmpz, inter, work1(i,j) )
tmpz(1,1)=u2(ip(i,j,1),ip(i,j,2))
tmpz(2,1)=u2(ip(i,j,1)+1,ip(i,j,2))
tmpz(1,2)=u2(ip(i,j,1),ip(i,j,2)+1)
tmpz(2,2)=u2(ip(i,j,1)+1,ip(i,j,2)+1)
call interpolation_2d( tmpx, tmpy, tmpz, inter, work2(i,j) )
end do
end do
!-- 2. 内挿した配列を使って, 内挿点での x,y 座標(その要素番号は, ix,iy に格納)
!-- の位置ベクトルとの外積を計算
do j=1,nt
do i=1,nr
work3(i,j)=0.0
posx(i,j)=point(i,j,1)-xc
posy(i,j)=point(i,j,2)-yc
posz(i,j)=0.0
end do
end do
select case (charc)
case ('vector')
call vec_prod( nr, nt, 1, posx, posy, posz, work1, work2, work3, vecx, vecy, vecz )
case ('scalar')
call dot_prod( nr, nt, 1, posx, posy, posz, work1, work2, work3, vecz )
case default
write(*,*) "error : bad character. select 'vector', or 'scalar'."
stop
end select
!-- 3. ベクトルの各成分のうち, z 成分について (2 次元水平面ベクトル同士の外積)
!-- 位置ベクトルの絶対値で割る. -> 接線風速成分の内挿した値が得られる.
call abst( nr, nt, 1, posx, posy, posz, abpos )
do j=1,nt
do i=2,nr
vecz(i,j)=vecz(i,j)/abpos(i,j)
end do
end do
!-- 過程(4) ---
do i=2,nr
call Mean_1d( nt, vecz(i,:), v(i) )
end do
v(1)=0.0
end subroutine tangent_mean_vec