271 lines
7.0 KiB
Fortran
271 lines
7.0 KiB
Fortran
module reflections
|
|
use const_and_precisions, only : wp_, comp_tiny, comp_eps, comp_huge
|
|
|
|
implicit none
|
|
|
|
private
|
|
public :: reflect, inters_linewall
|
|
public :: linecone_coord, interssegm_coord, interssegm
|
|
public :: wall_refl
|
|
|
|
contains
|
|
|
|
subroutine reflect(ki,nsurf,ko)
|
|
real(wp_), intent(in), dimension(3) :: ki
|
|
real(wp_), intent(in), dimension(3) :: nsurf
|
|
real(wp_), intent(out), dimension(3) :: ko
|
|
real(wp_) :: twokn,norm2
|
|
norm2 = dot_product(nsurf,nsurf)
|
|
if (norm2>0) then
|
|
twokn = 2.0_wp_*dot_product(ki,nsurf)/norm2
|
|
ko=ki-twokn*nsurf
|
|
else
|
|
ko=ki
|
|
end if
|
|
end subroutine reflect
|
|
|
|
|
|
|
|
subroutine inters_linewall(xv, kv, wall, sint, normw)
|
|
use types, only : contour
|
|
|
|
! subroutine arguments
|
|
real(wp_), intent(in) :: xv(3), kv(3)
|
|
type(contour), intent(in) :: wall
|
|
real(wp_), intent(out) :: sint
|
|
real(wp_), intent(out) :: normw(3)
|
|
|
|
! local variables
|
|
integer :: i, j, ni, iint, first
|
|
real(wp_) :: si(2), ti(2)
|
|
real(wp_) :: drw, dzw, xint, yint, rint, l, kxy
|
|
|
|
sint=comp_huge
|
|
iint=0
|
|
normw=0
|
|
do i=1, size(wall%R)-1
|
|
! search intersections with i-th wall segment
|
|
call linecone_coord(xv, kv, wall%R(i:i+1), wall%z(i:i+1), si, ti, ni)
|
|
! discard solutions with s<=0
|
|
first=ni+1
|
|
do j=1,ni
|
|
if (si(j)>0) then
|
|
first=j
|
|
exit
|
|
end if
|
|
end do
|
|
do j=first,ni
|
|
if ((si(j)<sint .or. iint==0) .and. ti(j)>=0 .and. ti(j)<=1) then
|
|
! check intersection is in r,z range and keep the closest
|
|
sint = si(j)
|
|
iint = i
|
|
end if
|
|
end do
|
|
end do
|
|
if (iint==0) return
|
|
! calculate wall normal at intersection point
|
|
drw = wall%R(iint+1) - wall%R(iint)
|
|
dzw = wall%z(iint+1) - wall%z(iint)
|
|
xint = xv(1) + sint*kv(1)
|
|
yint = xv(2) + sint*kv(2)
|
|
rint = hypot(xint, yint)
|
|
l = hypot(drw, dzw)
|
|
kxy = norm2(kv(1:2))
|
|
normw(3) = -drw/l
|
|
if (rint>0) then
|
|
normw(1) = xint/rint*dzw/l
|
|
normw(2) = yint/rint*dzw/l
|
|
else
|
|
normw(1) = kv(1)/kxy*dzw/l
|
|
normw(2) = kv(2)/kxy*dzw/l
|
|
end if
|
|
! reverse normal if k.n>0
|
|
if (dot_product(normw,kv)>0) normw=-normw
|
|
end subroutine inters_linewall
|
|
|
|
|
|
|
|
subroutine linecone_coord(xv,kv,rs,zs,s,t,n)
|
|
use utils, only : sort_pair
|
|
real(wp_), intent(in), dimension(3) :: xv,kv
|
|
real(wp_), intent(in), dimension(2) :: rs,zs
|
|
real(wp_), dimension(2), intent(out) :: s,t
|
|
integer, intent(out) :: n
|
|
real(wp_) :: x0,y0,z0,kx,ky,kz
|
|
real(wp_) :: dr,dz,r,a,bhalf,c,delta,tvertex,zvertex,srmin,rmin,zrmin
|
|
x0=xv(1)
|
|
y0=xv(2)
|
|
z0=xv(3)
|
|
kx=kv(1)
|
|
ky=kv(2)
|
|
kz=kv(3)
|
|
dr = rs(2)-rs(1)
|
|
dz = zs(2)-zs(1)
|
|
s = 0
|
|
t = 0
|
|
if (abs(dz)<comp_tiny) then
|
|
!surface in horizontal plane
|
|
if (abs(kz)<comp_tiny .or. abs(dr)<comp_tiny) then
|
|
n = 0
|
|
else
|
|
s(1) = (zs(1)-z0)/kz
|
|
r = sqrt((x0+s(1)*kx)**2+(y0+s(1)*ky)**2)
|
|
t(1) = (r-rs(1))/dr
|
|
n = 1
|
|
end if
|
|
else
|
|
a = (kx**2+ky**2) - (dr/dz*kz)**2
|
|
bhalf = -dr/dz*kz*rs(1) + (kx*x0 + ky*y0) - (dr/dz)**2*kz*(z0-zs(1))
|
|
c = (x0**2+y0**2) - (rs(1) + dr/dz*(z0-zs(1)))**2
|
|
if (abs(a)<comp_tiny) then
|
|
!line parallel to cone generator
|
|
if (abs(dr)<comp_tiny) then
|
|
!cylinder and vertical line
|
|
n = 0
|
|
else
|
|
tvertex = -rs(1)/dr
|
|
zvertex = zs(1) + tvertex*dz
|
|
srmin = -(kx*x0 + ky*y0)/(kx**2+ky**2)
|
|
rmin = sqrt((x0+srmin*kx)**2+(y0+srmin*ky)**2)
|
|
zrmin = z0 + srmin*kz
|
|
if (rmin<comp_tiny .and. abs(zrmin-zvertex)<comp_tiny) then
|
|
!line passing by cone vertex
|
|
!s(1) = srmin
|
|
!t(1) = tvertex
|
|
!n = 1
|
|
n = 0
|
|
else
|
|
s(1) = -0.5_wp_*c/bhalf
|
|
t(1) = (kz*s(1)+(z0-zs(1)))/dz
|
|
n = 1
|
|
end if
|
|
end if
|
|
else
|
|
delta = bhalf**2 - a*c
|
|
if (delta<0) then
|
|
n = 0
|
|
else
|
|
s(1) = (-bhalf+sqrt(delta))/a
|
|
s(2) = (-bhalf-sqrt(delta))/a
|
|
call sort_pair(s)
|
|
t(:) = (kz*s(:)+(z0-zs(1)))/dz
|
|
n = 2
|
|
end if
|
|
end if
|
|
end if
|
|
end subroutine linecone_coord
|
|
|
|
|
|
|
|
subroutine interssegm_coord(xa,ya,xb,yb,s,t,ierr)
|
|
real(wp_), dimension(2), intent(in) :: xa,ya,xb,yb
|
|
real(wp_), intent(out) :: s,t
|
|
integer, intent(out) :: ierr
|
|
real(wp_) :: crossprod,dxa,dya,dxb,dyb
|
|
dxa = xa(2)-xa(1)
|
|
dya = ya(2)-ya(1)
|
|
dxb = xb(2)-xb(1)
|
|
dyb = yb(2)-yb(1)
|
|
crossprod = dxb*dya - dxa*dyb
|
|
if (abs(crossprod)<comp_tiny) then
|
|
s = 0
|
|
t = 0
|
|
ierr = 1
|
|
else
|
|
s = (dyb*(xa(1)-xb(1)) - dxb*(ya(1)-yb(1)))/crossprod
|
|
t = (dya*(xa(1)-xb(1)) - dxa*(ya(1)-yb(1)))/crossprod
|
|
ierr = 0
|
|
end if
|
|
end subroutine interssegm_coord
|
|
|
|
|
|
|
|
function interssegm(xa,ya,xb,yb)
|
|
real(wp_), dimension(2), intent(in) :: xa,ya,xb,yb
|
|
logical :: interssegm
|
|
real(wp_) :: s,t
|
|
integer :: ierr
|
|
interssegm = .false.
|
|
call interssegm_coord(xa,ya,xb,yb,s,t,ierr)
|
|
if (ierr==0 .and. s>=0 .and. s<=1 .and. &
|
|
t>=0 .and. t<=1) interssegm = .true.
|
|
end function interssegm
|
|
|
|
|
|
subroutine wall_refl(wall, xv, anv, ext, eyt, xvrfl, &
|
|
anvrfl, extr, eytr, walln, irfl)
|
|
use types, only : contour
|
|
|
|
! subroutine arguments
|
|
type(contour), intent(in) :: wall
|
|
integer :: irfl
|
|
real(wp_), dimension(3) :: xv,anv,xvrfl,anvrfl,walln
|
|
complex(wp_) :: ext,eyt,extr,eytr
|
|
! local variables
|
|
real(wp_) :: smax,rrm,zzm
|
|
real(wp_), dimension(3) :: anv0,vv1,vv2,vv3
|
|
complex(wp_) :: eztr
|
|
complex(wp_), dimension(3) :: evin,evrfl
|
|
|
|
anv0=anv/sqrt(anv(1)**2+anv(2)**2+anv(3)**2)
|
|
rrm=1.0e-2_wp_*sqrt(xv(1)**2+xv(2)**2)
|
|
zzm=1.0e-2_wp_*xv(3)
|
|
|
|
! computation of reflection coordinates and normal to the wall
|
|
call inters_linewall(xv/1.0e2_wp_, anv0, wall, smax, walln)
|
|
smax=smax*1.0e2_wp_
|
|
xvrfl=xv+smax*anv0
|
|
irfl=1
|
|
if (.not. wall%contains(rrm,zzm)) then
|
|
! first wall interface is outside-inside
|
|
if (dot_product(walln,walln)<tiny(walln)) then
|
|
! wall never hit
|
|
xvrfl=xv
|
|
anvrfl=anv0
|
|
extr=ext
|
|
eytr=eyt
|
|
irfl=0
|
|
return
|
|
end if
|
|
! search second wall interface (inside-outside)
|
|
call inters_linewall(xvrfl/1.0e2_wp_, anv0, wall, smax, walln)
|
|
smax=smax*1.0e2_wp_
|
|
xvrfl=xvrfl+smax*anv0
|
|
irfl=2
|
|
end if
|
|
|
|
! rotation matrix from local to lab frame
|
|
vv1(1)=anv0(2)
|
|
vv1(2)=-anv0(1)
|
|
vv1(3)=0.0_wp_
|
|
vv2(1)=anv0(1)*anv0(3)
|
|
vv2(2)=anv0(2)*anv0(3)
|
|
vv2(3)=-anv0(1)*anv0(1)-anv0(2)*anv0(2)
|
|
vv1=vv1/sqrt(vv1(1)**2+vv1(2)**2+vv1(3)**2)
|
|
vv2=vv2/sqrt(vv2(1)**2+vv2(2)**2+vv2(3)**2)
|
|
vv3=anv0
|
|
|
|
evin=ext*vv1+eyt*vv2
|
|
! wave vector and electric field after reflection in lab frame
|
|
anvrfl=anv0-2.0_wp_* &
|
|
(anv0(1)*walln(1)+anv0(2)*walln(2)+anv0(3)*walln(3))*walln
|
|
evrfl=-evin+2.0_wp_* &
|
|
(evin(1)*walln(1)+evin(2)*walln(2)+evin(3)*walln(3))*walln
|
|
|
|
vv1(1)=anvrfl(2)
|
|
vv1(2)=-anvrfl(1)
|
|
vv1(3)=0.0_wp_
|
|
vv2(1)=anvrfl(1)*anvrfl(3)
|
|
vv2(2)=anvrfl(2)*anvrfl(3)
|
|
vv2(3)=-anvrfl(1)*anvrfl(1)-anvrfl(2)*anvrfl(2)
|
|
vv1=vv1/sqrt(vv1(1)**2+vv1(2)**2+vv1(3)**2)
|
|
vv2=vv2/sqrt(vv2(1)**2+vv2(2)**2+vv2(3)**2)
|
|
vv3=anvrfl/sqrt(anvrfl(1)**2+anvrfl(2)**2+anvrfl(3)**2)
|
|
|
|
extr=dot_product(vv1,evrfl)
|
|
eytr=dot_product(vv2,evrfl)
|
|
eztr=dot_product(vv3,evrfl)
|
|
end subroutine wall_refl
|
|
|
|
end module reflections
|