gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

USER_PROBLEM: Implement absorption/diffusion layer near Y boundaries.

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-04 10:53:03 -03:00
parent c3ec26fb00
commit 05f46eeb7e
1 changed files with 54 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
sources/user_problem.F90
View File

@ -77,14 +77,16 @@ module user_problem
real(kind=8), save :: ylo = -9.00d+99
real(kind=8), save :: yup = 9.00d+99
real(kind=8), save :: aamp = 1.00d-02
real(kind=8), save :: acut = 5.00d-01
real(kind=8), save :: adec = 5.00d-01
real(kind=8), save :: tabs = 1.00d+00
real(kind=8), save :: adif = 5.00d-01
real(kind=8), save :: acut = 1.00d+00
real(kind=8), save :: adec = 1.00d+00
real(kind=8), save :: yabs = 9.00d+99
integer(kind=4), save :: runit = 33
logical, save :: resistive = .false.
logical, save :: absorption = .false.
logical, save :: resistive = .false.
! flag indicating if the gravitational source term is enabled
!
@ -152,6 +154,7 @@ module user_problem
! local variables
!
character(len=64) :: perturbation = "noise", append = "off", fname
character(len=64) :: enable_absorption = "off"
logical :: flag
integer :: n, kd
real(kind=8) :: thh, fc, ka, ydis = 9.00d+99
@ -426,7 +429,15 @@ module user_problem
! absorption parameters
!
call get_parameter("aamp", aamp)
call get_parameter("enable_shapes", enable_absorption)
select case(trim(enable_absorption))
case ("on", "ON", "t", "T", "y", "Y", "true", "TRUE", "yes", "YES")
absorption = .true.
case default
absorption = .false.
end select
call get_parameter("tabs", tabs)
call get_parameter("adif", adif)
call get_parameter("acut", acut)
call get_parameter("adec", adec)
yabs = ymax - abs(acut)
@ -468,10 +479,14 @@ module user_problem
call print_parameter(verbose, '(*) ycut' , ycut)
call print_parameter(verbose, '(*) xdec' , xdec)
call print_parameter(verbose, '(*) ydec' , ydec)
call print_parameter(verbose, '(*) aamp' , aamp)
call print_parameter(verbose, '(*) acut' , acut)
call print_parameter(verbose, '(*) adec' , adec)
call print_parameter(verbose, '(*) ydistance' , ydis)
call print_parameter(verbose, '(*) ydistance (Vrec)', ydis)
if (absorption) then
call print_parameter(verbose, '(*) tabs (absorption)', tabs)
call print_parameter(verbose, '(*) adif (diffusion)' , adif)
call print_parameter(verbose, '(*) acut' , acut)
call print_parameter(verbose, '(*) adec' , adec)
call print_parameter(verbose, '( ) yabs' , yabs)
end if
end if ! status
#ifdef PROFILE
@ -1049,10 +1064,11 @@ module user_problem
use blocks , only : block_data
use constants , only : pi
use coordinates, only : nn => bcells
use coordinates, only : ymax, ay
use coordinates, only : ymax, ay, adx, ady, adz
use equations , only : nv
use equations , only : idn, ivx, ivy, ivz, ipr, ibx, iby, ibz, ibp
use equations , only : prim2cons
use operators , only : laplace
implicit none
@ -1060,10 +1076,16 @@ module user_problem
real(kind=8) , intent(in) :: time, dt
integer :: j, k = 1
real(kind=8) :: fl, fr
real(kind=8) :: fl, fr, fd, fa, fb
real(kind=8), dimension(nv,nn) :: q, u
real(kind=8), dimension(nn) :: yc, fc
real(kind=8), dimension(3) :: dh = 1.0d+00
real(kind=8), dimension(nn) :: yc, fc
real(kind=8), dimension(nv,nn) :: q, u
#if NDIMS == 3
real(kind=8), dimension(nn,nn,nn) :: q2
#else /* NDIMS == 3 */
real(kind=8), dimension(nn,nn, 1) :: q2
#endif /* NDIMS == 3 */
!-------------------------------------------------------------------------------
!
@ -1075,19 +1097,35 @@ module user_problem
if (yc(1) < -yabs .or. yc(nn) > yabs) then
dh(1) = adx(pdata%meta%level)
dh(2) = ady(pdata%meta%level)
#if NDIMS == 3
dh(3) = adz(pdata%meta%level)
#endif /* NDIMS == 3 */
fa = dt / tabs
fb = 5.0d-01 * adif * minval(dh(1:NDIMS))**2
call laplace(dh, pdata%q(ivy,:,:,:), q2)
fc(:) = (abs(yc(:)) - yabs) / adec
do j = 1, nn
if (fc(j) > 0.0d+00 .and. fc(j) < 1.0d+00) then
fr = aamp * sin(5.0d-01 * pi * yc(j))**2
if (fc(j) >= 0.0d+00) then
if (fc(j) <= 1.0d+00) then
fr = fa * sin(5.0d-01 * pi * yc(j))**2
else
fr = fa
end if
fl = 1.0d+00 - fr
fd = fr * fb
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
q(idn,:) = fl * pdata%q(idn,:,j,k) + fr * dens
q(ivx,:) = fl * pdata%q(ivx,:,j,k)
q(ivy,:) = pdata%q(ivy,:,j,k)
q(ivy,:) = pdata%q(ivy,:,j,k) + fd * q2(:,j,k)
q(ivz,:) = fl * pdata%q(ivz,:,j,k)
q(ibx,:) = fl * pdata%q(ibx,:,j,k) + fr * sign(bamp, yc(j))
q(iby,:) = fl * pdata%q(iby,:,j,k)
@ -1101,27 +1139,6 @@ module user_problem
pdata%u(:,:,j,k) = u(:,:)
#if NDIMS == 3
end do
#endif /* NDIMS == 3 */
else if (fc(j) >= 1.0d+00) then
#if NDIMS == 3
do k = 1, nn
#endif /* NDIMS == 3 */
q(idn,:) = dens
q(ivx,:) = 0.0d+00
q(ivy,:) = pdata%q(ivy,:,j,k)
q(ivz,:) = 0.0d+00
q(ibx,:) = sign(bamp, yc(j))
q(iby,:) = 0.0d+00
q(ibz,:) = bgui
q(ibp,:) = 0.0d+00
if (ipr > 0) q(ipr,:) = pres
call prim2cons(q(:,:), u(:,:))
pdata%q(:,:,j,k) = q(:,:)
pdata%u(:,:,j,k) = u(:,:)
#if NDIMS == 3
end do
#endif /* NDIMS == 3 */
end if
end do