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

Merge branch 'master' into reconnection

Browse Source
This commit is contained in:
Grzegorz Kowal 2022-02-10 12:18:34 -03:00
commit 0ed2272285
5 changed files with 4626 additions and 6040 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
sources/blocks.F90
View File

@ -280,16 +280,9 @@ module blocks
!
integer(kind=4) :: direction
! the corner index determining the position of
! the corner boundary and when direction is
! specified also the face or edge boundaries
! the boundary region location
!
integer(kind=4) :: corner(NDIMS)
! the level difference between the block and
! its neighbor
!
integer(kind=4) :: level_difference
integer(kind=4) :: location(NDIMS)
end type block_info
@ -1045,7 +1038,7 @@ module blocks
!
allocate(pdata%uu(nvars,nx,ny,nz,nregs), pdata%du(nvars,nx,ny,nz), &
pdata%q(nvars,nx,ny,nz), &
pdata%fx(nflux,2,ny,nz), pdata%fy(nflux,nx,2,nz), &
pdata%fx(nflux,ny,nz,2), pdata%fy(nflux,nx,nz,2), &
#if NDIMS == 3
pdata%fz(nflux,nx,ny,2), &
#endif /* NDIMS == 3 */

10203
sources/boundaries.F90
View File

File diff suppressed because it is too large Load Diff

107
sources/equations.F90
View File

@ -1271,18 +1271,19 @@ module equations
! subroutine UPDATE_PRIMITIVE_VARIABLES:
! -------------------------------------
!
! Subroutine updates primitive variables from their conservative
! representation. This process is done once after advance of the conserved
! variables due to their evolution in time.
! Subroutine updates primitive to conservative variables.
!
! Arguments:
!
! uu - the input array of conservative variables;
! qq - the output array of primitive variables;
! uu - the input array of conservative variables;
! qq - the output array of primitive variables;
! ghosts - the flag indicating the conversion has to be done for
! the ghost zones too;
! status - the call status;
!
!===============================================================================
!
subroutine update_primitive_variables(uu, qq, status)
subroutine update_primitive_variables(uu, qq, ghosts, status)
use coordinates, only : nn => bcells
use coordinates, only : nb, ne, nbl, neu
@ -1291,6 +1292,7 @@ module equations
real(kind=8), dimension(:,:,:,:), intent(inout) :: uu
real(kind=8), dimension(:,:,:,:), intent(inout) :: qq
logical , intent(in) :: ghosts
integer , intent(out) :: status
integer :: i, j, k
@ -1299,56 +1301,75 @@ module equations
!
status = 0
if (ghosts) then
#if NDIMS == 2
k = 1
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
do k = 1, nn
#endif /* NDIMS == 3 */
do j = nb, ne
do j = 1, nn
call cons2prim(uu(1:nv,nb:ne,j,k), qq(1:nv,nb:ne,j,k), status)
call cons2prim(uu(:,:,j,k), qq(:,:,j,k), status)
if (status /= 0) go to 100
if (status /= 0) go to 100
end do ! j = nb, ne
end do
#if NDIMS == 3
end do ! k = nb, ne
end do
#endif /* NDIMS == 3 */
else
#if NDIMS == 2
k = 1
#endif /* NDIMS == 2 */
#if NDIMS == 3
do k = nb, ne
#endif /* NDIMS == 3 */
do j = nb, ne
call cons2prim(uu(:,nb:ne,j,k), qq(:,nb:ne,j,k), status)
if (status /= 0) go to 100
end do ! j = nb, ne
#if NDIMS == 3
end do ! k = nb, ne
#endif /* NDIMS == 3 */
#if NDIMS == 3
do i = nbl, 1, -1
qq(1:nv, i,nb:ne,nb:ne) = qq(1:nv,nb,nb:ne,nb:ne)
end do
do i = neu, nn
qq(1:nv, i,nb:ne,nb:ne) = qq(1:nv,ne,nb:ne,nb:ne)
end do
do j = nbl, 1, -1
qq(1:nv, : , j,nb:ne) = qq(1:nv, : ,nb,nb:ne)
end do
do j = neu, nn
qq(1:nv, : , j,nb:ne) = qq(1:nv, : ,ne,nb:ne)
end do
do k = nbl, 1, -1
qq(1:nv, : , : , k) = qq(1:nv, : , : ,nb)
end do
do k = neu, nn
qq(1:nv, : , : , k) = qq(1:nv, : , : ,ne)
end do
do i = nbl, 1, -1
qq(1:nv, i,nb:ne,nb:ne) = qq(1:nv,nb,nb:ne,nb:ne)
end do
do i = neu, nn
qq(1:nv, i,nb:ne,nb:ne) = qq(1:nv,ne,nb:ne,nb:ne)
end do
do j = nbl, 1, -1
qq(1:nv, : , j,nb:ne) = qq(1:nv, : ,nb,nb:ne)
end do
do j = neu, nn
qq(1:nv, : , j,nb:ne) = qq(1:nv, : ,ne,nb:ne)
end do
do k = nbl, 1, -1
qq(1:nv, : , : , k) = qq(1:nv, : , : ,nb)
end do
do k = neu, nn
qq(1:nv, : , : , k) = qq(1:nv, : , : ,ne)
end do
#else /* NDIMS == 3 */
do i = nbl, 1, -1
qq(1:nv, i,nb:ne, : ) = qq(1:nv,nb,nb:ne, : )
end do
do i = neu, nn
qq(1:nv, i,nb:ne, : ) = qq(1:nv,ne,nb:ne, : )
end do
do j = nbl, 1, -1
qq(1:nv, : , j, : ) = qq(1:nv, : ,nb, : )
end do
do j = neu, nn
qq(1:nv, : , j, : ) = qq(1:nv, : ,ne, : )
end do
do i = nbl, 1, -1
qq(1:nv, i,nb:ne, : ) = qq(1:nv,nb,nb:ne, : )
end do
do i = neu, nn
qq(1:nv, i,nb:ne, : ) = qq(1:nv,ne,nb:ne, : )
end do
do j = nbl, 1, -1
qq(1:nv, : , j, : ) = qq(1:nv, : ,nb, : )
end do
do j = neu, nn
qq(1:nv, : , j, : ) = qq(1:nv, : ,ne, : )
end do
#endif /* NDIMS == 3 */
end if
100 continue

218
sources/evolution.F90
View File

@ -1254,7 +1254,7 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, 0.0d+00, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(0.0d+00, 0.0d+00, pdata)
#if NDIMS == 3
sc(:,:,:,:) = atol + rtol * abs(pdata%uu(1:nf,nb:ne,nb:ne,nb:ne,1))
@ -1329,7 +1329,7 @@ module evolution
#endif /* NDIMS == 3 */
call update_increment(pdata)
call update_sources(pdata, time + h0, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(time + h0, 0.0d+00, pdata)
#if NDIMS == 3
df(:,:,:,:) = df(:,:,:,:) - pdata%du(1:nf,nb:ne,nb:ne,nb:ne)
@ -1526,11 +1526,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, dt, pdata%du(:,:,:,:))
call update_sources(t, dt, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) return
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1621,11 +1623,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(t, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1648,11 +1652,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1748,11 +1754,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(t, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1778,11 +1786,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1807,11 +1817,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1911,11 +1923,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(t, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1940,11 +1954,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1967,11 +1983,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -1996,11 +2014,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2105,11 +2125,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(t, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2134,11 +2156,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2162,11 +2186,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2191,11 +2217,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2222,11 +2250,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2343,11 +2373,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(t, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2373,11 +2405,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2403,11 +2437,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2434,11 +2470,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2467,11 +2505,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds, pdata%du(:,:,:,:))
call update_sources(t, ds, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2590,11 +2630,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(t, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2636,11 +2678,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, ds(1), pdata%du(:,:,:,:))
call update_sources(t, ds(1), pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2665,11 +2709,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, t, 1.0d-01 * dt, pdata%du(:,:,:,:))
call update_sources(t, 1.0d-01 * dt, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2802,11 +2848,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -2835,11 +2883,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3034,11 +3084,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3079,11 +3131,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3304,11 +3358,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3345,11 +3401,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3396,11 +3454,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3588,12 +3648,14 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, time, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(time, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
end if
!$omp parallel do default(shared) private(pdata)
@ -3623,11 +3685,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, dtm, pdata%du(:,:,:,:))
call update_sources(tm, dtm, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3678,11 +3742,13 @@ module evolution
pdata => data_blocks(l)%ptr
call update_increment(pdata)
call update_sources(pdata, tm, 0.0d+00, pdata%du(:,:,:,:))
call update_sources(tm, 0.0d+00, pdata)
end do
!$omp end parallel do
call boundary_fluxes()
call boundary_fluxes(status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
@ -3876,10 +3942,10 @@ module evolution
! store the block interface fluxes
!
pdata%fx(:,1,:,:) = f(:,nbl,:,:,1)
pdata%fx(:,2,:,:) = f(:,ne ,:,:,1)
pdata%fy(:,:,1,:) = f(:,:,nbl,:,2)
pdata%fy(:,:,2,:) = f(:,:,ne ,:,2)
pdata%fx(:,:,:,1) = f(:,nbl,:,:,1)
pdata%fx(:,:,:,2) = f(:,ne ,:,:,1)
pdata%fy(:,:,:,1) = f(:,:,nbl,:,2)
pdata%fy(:,:,:,2) = f(:,:,ne ,:,2)
#if NDIMS == 3
pdata%fz(:,:,:,1) = f(:,:,:,nbl,3)
pdata%fz(:,:,:,2) = f(:,:,:,ne ,3)
@ -4038,12 +4104,15 @@ module evolution
n = get_dblocks()
call boundary_variables(tm, dtm, status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata,s)
do l = 1, n
pdata => data_blocks(l)%ptr
if (pdata%meta%update) then
call update_primitive_variables(pdata%u, pdata%q, s)
call update_primitive_variables(pdata%u, pdata%q, .true., s)
!$omp critical
if (s /= 0) status = 1
!$omp end critical
@ -4057,9 +4126,6 @@ module evolution
#endif /* MPI */
if (status /= 0) go to 100
call boundary_variables(tm, dtm, status)
if (status /= 0) go to 100
!$omp parallel do default(shared) private(pdata)
do l = 1, n
pdata => data_blocks(l)%ptr

125
sources/sources.F90
View File

@ -34,12 +34,11 @@ module sources
! interfaces for the extra source terms subroutine
!
abstract interface
subroutine update_extra_sources_iface(pdata, t, dt, du)
subroutine update_extra_sources_iface(t, dt, pdata)
use blocks, only : block_data
implicit none
type(block_data), pointer , intent(inout) :: pdata
real(kind=8) , intent(in) :: t, dt
real(kind=8), dimension(:,:,:,:), intent(inout) :: du
type(block_data), pointer , intent(inout) :: pdata
end subroutine
end interface
@ -260,13 +259,12 @@ module sources
!
! Arguments:
!
! pdata - the pointer to a data block;
! t, dt - the time and time increment;
! du - the array of variable increment;
! pdata - the pointer to a data block;
!
!===============================================================================
!
subroutine update_sources(pdata, t, dt, du)
subroutine update_sources(t, dt, pdata)
use blocks , only : block_data
use coordinates, only : nn => bcells
@ -285,9 +283,8 @@ module sources
implicit none
type(block_data), pointer , intent(inout) :: pdata
real(kind=8) , intent(in) :: t, dt
real(kind=8), dimension(:,:,:,:), intent(inout) :: du
type(block_data), pointer , intent(inout) :: pdata
logical, save :: first = .true.
@ -378,10 +375,10 @@ module sources
! add source terms to momentum equations
!
du(imx,i,j,k) = du(imx,i,j,k) + gx
du(imy,i,j,k) = du(imy,i,j,k) + gy
pdata%du(imx,i,j,k) = pdata%du(imx,i,j,k) + gx
pdata%du(imy,i,j,k) = pdata%du(imy,i,j,k) + gy
#if NDIMS == 3
du(imz,i,j,k) = du(imz,i,j,k) + gz
pdata%du(imz,i,j,k) = pdata%du(imz,i,j,k) + gz
#endif /* NDIMS == 3 */
! add source terms to total energy equation
@ -389,13 +386,15 @@ module sources
if (ien > 0) then
#if NDIMS == 2
du(ien,i,j,k) = du(ien,i,j,k) + gx * pdata%q(ivx,i,j,k) &
+ gy * pdata%q(ivy,i,j,k)
pdata%du(ien,i,j,k) = pdata%du(ien,i,j,k) &
+ gx * pdata%q(ivx,i,j,k) &
+ gy * pdata%q(ivy,i,j,k)
#endif /* NDIMS == 2 */
#if NDIMS == 3
du(ien,i,j,k) = du(ien,i,j,k) + gx * pdata%q(ivx,i,j,k) &
+ gy * pdata%q(ivy,i,j,k) &
+ gz * pdata%q(ivz,i,j,k)
pdata%du(ien,i,j,k) = pdata%du(ien,i,j,k) &
+ gx * pdata%q(ivx,i,j,k) &
+ gy * pdata%q(ivy,i,j,k) &
+ gz * pdata%q(ivz,i,j,k)
#endif /* NDIMS == 3 */
end if
@ -413,7 +412,7 @@ module sources
if (viscosity > 0.0d+00) then
if (work_in_use(nt)) &
call print_message(loc, "Workspace is being used right now! " // &
call print_message(loc, "Workspace is being used right now! " // &
"Corruptions can occur!")
work_in_use(nt) = .true.
@ -480,7 +479,7 @@ module sources
! add viscous source terms to the X momentum equation
!
du(imx,:,:,:) = du(imx,:,:,:) + db(:,:,:)
pdata%du(imx,:,:,:) = pdata%du(imx,:,:,:) + db(:,:,:)
! calculate the divergence of the second tensor row
!
@ -488,7 +487,7 @@ module sources
! add viscous source terms to the Y momentum equation
!
du(imy,:,:,:) = du(imy,:,:,:) + db(:,:,:)
pdata%du(imy,:,:,:) = pdata%du(imy,:,:,:) + db(:,:,:)
! calculate the divergence of the third tensor row
!
@ -496,7 +495,7 @@ module sources
! add viscous source terms to the Z momentum equation
!
du(imz,:,:,:) = du(imz,:,:,:) + db(:,:,:)
pdata%du(imz,:,:,:) = pdata%du(imz,:,:,:) + db(:,:,:)
! add viscous source term to total energy equation
!
@ -512,14 +511,14 @@ module sources
! calculate scalar product of v and viscous stress tensor τ
!
gx = pdata%q(ivx,i,j,k) * tmp(inx,inx,i,j,k) &
+ pdata%q(ivy,i,j,k) * tmp(inx,iny,i,j,k) &
gx = pdata%q(ivx,i,j,k) * tmp(inx,inx,i,j,k) &
+ pdata%q(ivy,i,j,k) * tmp(inx,iny,i,j,k) &
+ pdata%q(ivz,i,j,k) * tmp(inx,inz,i,j,k)
gy = pdata%q(ivx,i,j,k) * tmp(iny,inx,i,j,k) &
+ pdata%q(ivy,i,j,k) * tmp(iny,iny,i,j,k) &
gy = pdata%q(ivx,i,j,k) * tmp(iny,inx,i,j,k) &
+ pdata%q(ivy,i,j,k) * tmp(iny,iny,i,j,k) &
+ pdata%q(ivz,i,j,k) * tmp(iny,inz,i,j,k)
gz = pdata%q(ivx,i,j,k) * tmp(inz,inx,i,j,k) &
+ pdata%q(ivy,i,j,k) * tmp(inz,iny,i,j,k) &
gz = pdata%q(ivx,i,j,k) * tmp(inz,inx,i,j,k) &
+ pdata%q(ivy,i,j,k) * tmp(inz,iny,i,j,k) &
+ pdata%q(ivz,i,j,k) * tmp(inz,inz,i,j,k)
! update (v.τ), use the first row of the tensor tmp
@ -540,7 +539,7 @@ module sources
! update the energy increment
!
du(ien,:,:,:) = du(ien,:,:,:) + db(:,:,:)
pdata%du(ien,:,:,:) = pdata%du(ien,:,:,:) + db(:,:,:)
end if ! ien > 0
@ -553,7 +552,7 @@ module sources
if (magnetized) then
if (work_in_use(nt)) &
call print_message(loc, "Workspace is being used right now! " // &
call print_message(loc, "Workspace is being used right now! " // &
"Corruptions can occur!")
work_in_use(nt) = .true.
@ -578,9 +577,12 @@ module sources
!
if (glm_type < 3 .or. ien > 0) then
du(imx,:,:,:) = du(imx,:,:,:) - db(:,:,:) * pdata%q(ibx,:,:,:)
du(imy,:,:,:) = du(imy,:,:,:) - db(:,:,:) * pdata%q(iby,:,:,:)
du(imz,:,:,:) = du(imz,:,:,:) - db(:,:,:) * pdata%q(ibz,:,:,:)
pdata%du(imx,:,:,:) = pdata%du(imx,:,:,:) &
- db(:,:,:) * pdata%q(ibx,:,:,:)
pdata%du(imy,:,:,:) = pdata%du(imy,:,:,:) &
- db(:,:,:) * pdata%q(iby,:,:,:)
pdata%du(imz,:,:,:) = pdata%du(imz,:,:,:) &
- db(:,:,:) * pdata%q(ibz,:,:,:)
end if ! ien > 0
@ -591,9 +593,12 @@ module sources
! update magnetic field component increments, i.e.
! d/dt B + ∇.F = - (∇.B)v
!
du(ibx,:,:,:) = du(ibx,:,:,:) - db(:,:,:) * pdata%q(ivx,:,:,:)
du(iby,:,:,:) = du(iby,:,:,:) - db(:,:,:) * pdata%q(ivy,:,:,:)
du(ibz,:,:,:) = du(ibz,:,:,:) - db(:,:,:) * pdata%q(ivz,:,:,:)
pdata%du(ibx,:,:,:) = pdata%du(ibx,:,:,:) &
- db(:,:,:) * pdata%q(ivx,:,:,:)
pdata%du(iby,:,:,:) = pdata%du(iby,:,:,:) &
- db(:,:,:) * pdata%q(ivy,:,:,:)
pdata%du(ibz,:,:,:) = pdata%du(ibz,:,:,:) &
- db(:,:,:) * pdata%q(ivz,:,:,:)
! update the energy equation
!
@ -601,13 +606,14 @@ module sources
! calculate scalar product of velocity and magnetic field
!
tmp(inx,inx,:,:,:) = sum(pdata%q(ivx:ivz,:,:,:) &
* pdata%q(ibx:ibz,:,:,:), 1)
tmp(inx,inx,:,:,:) = sum(pdata%q(ivx:ivz,:,:,:) &
* pdata%q(ibx:ibz,:,:,:), 1)
! add the divergence potential source term to the energy equation, i.e.
! d/dt E + ∇.F = - (∇.B) (v.B)
!
du(ien,:,:,:) = du(ien,:,:,:) - db(:,:,:) * tmp(inx,inx,:,:,:)
pdata%du(ien,:,:,:) = pdata%du(ien,:,:,:) &
- db(:,:,:) * tmp(inx,inx,:,:,:)
end if ! ien > 0
@ -623,7 +629,7 @@ module sources
! add the divergence potential source term to the energy equation, i.e.
! d/dt ψ + ∇.F = ½ψ(∇.v)
!
du(ibp,:,:,:) = du(ibp,:,:,:) &
pdata%du(ibp,:,:,:) = pdata%du(ibp,:,:,:) &
+ 5.0d-01 * pdata%q(ibp,:,:,:) * db(:,:,:)
else if (ien > 0) then
@ -637,12 +643,12 @@ module sources
! update the divergence correcting field
! d/dt ψ + ∇.F = - (v.∇)ψ
!
du(ibp,:,:,:) = du(ibp,:,:,:) - db(:,:,:)
pdata%du(ibp,:,:,:) = pdata%du(ibp,:,:,:) - db(:,:,:)
! add the divergence potential source term to the energy equation, i.e.
! d/dt E + ∇.F = - B.(∇ψ)
!
du(ien,:,:,:) = du(ien,:,:,:) &
pdata%du(ien,:,:,:) = pdata%du(ien,:,:,:) &
- sum(pdata%q(ibx:ibz,:,:,:) * tmp(inx:inz,inx,:,:,:), 1)
end if ! glm == 3
@ -663,7 +669,7 @@ module sources
! calculate the local resistivity [ηu + ηa (|J|/Jcrit - 1) H(|J|/Jcrit)]
!
tmp(iny,iny,:,:,:) = resistivity + &
tmp(iny,iny,:,:,:) = resistivity + &
anomalous * max(0.0d+00, (tmp(inx,iny,:,:,:) - 1.0d+00))
! multiply the current density vector by the local resistivity (ηJ)
@ -678,9 +684,9 @@ module sources
! update magnetic field component increments
!
du(ibx,:,:,:) = du(ibx,:,:,:) - tmp(inx,iny,:,:,:)
du(iby,:,:,:) = du(iby,:,:,:) - tmp(iny,iny,:,:,:)
du(ibz,:,:,:) = du(ibz,:,:,:) - tmp(inz,iny,:,:,:)
pdata%du(ibx,:,:,:) = pdata%du(ibx,:,:,:) - tmp(inx,iny,:,:,:)
pdata%du(iby,:,:,:) = pdata%du(iby,:,:,:) - tmp(iny,iny,:,:,:)
pdata%du(ibz,:,:,:) = pdata%du(ibz,:,:,:) - tmp(inz,iny,:,:,:)
! update energy equation
!
@ -688,11 +694,11 @@ module sources
! calculate the vector product Bx(η ∇xB)
!
tmp(inx,iny,:,:,:) = pdata%q(iby,:,:,:) * tmp(inz,inz,:,:,:) &
tmp(inx,iny,:,:,:) = pdata%q(iby,:,:,:) * tmp(inz,inz,:,:,:) &
- pdata%q(ibz,:,:,:) * tmp(iny,inz,:,:,:)
tmp(iny,iny,:,:,:) = pdata%q(ibz,:,:,:) * tmp(inx,inz,:,:,:) &
tmp(iny,iny,:,:,:) = pdata%q(ibz,:,:,:) * tmp(inx,inz,:,:,:) &
- pdata%q(ibx,:,:,:) * tmp(inz,inz,:,:,:)
tmp(inz,iny,:,:,:) = pdata%q(ibx,:,:,:) * tmp(iny,inz,:,:,:) &
tmp(inz,iny,:,:,:) = pdata%q(ibx,:,:,:) * tmp(iny,inz,:,:,:) &
- pdata%q(iby,:,:,:) * tmp(inx,inz,:,:,:)
! calculate the divergence ∇.[Bx(η ∇xB)]
@ -702,7 +708,7 @@ module sources
! add the second resistive source term to the energy equation, i.e.
! d/dt E + ∇.F = η J²
!
du(ien,:,:,:) = du(ien,:,:,:) + db(:,:,:)
pdata%du(ien,:,:,:) = pdata%du(ien,:,:,:) + db(:,:,:)
end if ! energy equation present
@ -720,9 +726,9 @@ module sources
! update magnetic field component increments
!
du(ibx,:,:,:) = du(ibx,:,:,:) + tmp(iny,inx,:,:,:)
du(iby,:,:,:) = du(iby,:,:,:) + tmp(iny,iny,:,:,:)
du(ibz,:,:,:) = du(ibz,:,:,:) + tmp(iny,inz,:,:,:)
pdata%du(ibx,:,:,:) = pdata%du(ibx,:,:,:) + tmp(iny,inx,:,:,:)
pdata%du(iby,:,:,:) = pdata%du(iby,:,:,:) + tmp(iny,iny,:,:,:)
pdata%du(ibz,:,:,:) = pdata%du(ibz,:,:,:) + tmp(iny,inz,:,:,:)
! update energy equation
!
@ -731,10 +737,10 @@ module sources
! add the first resistive source term to the energy equation, i.e.
! d/dt E + ∇.F = η B.[Δ(B)]
!
du(ien,:,:,:) = du(ien,:,:,:) &
+ (pdata%q(ibx,:,:,:) * tmp(iny,inx,:,:,:) &
+ pdata%q(iby,:,:,:) * tmp(iny,iny,:,:,:) &
+ pdata%q(ibz,:,:,:) * tmp(iny,inz,:,:,:))
pdata%du(ien,:,:,:) = pdata%du(ien,:,:,:) &
+ (pdata%q(ibx,:,:,:) * tmp(iny,inx,:,:,:) &
+ pdata%q(iby,:,:,:) * tmp(iny,iny,:,:,:) &
+ pdata%q(ibz,:,:,:) * tmp(iny,inz,:,:,:))
! calculate current density J = ∇xB
!
@ -742,13 +748,14 @@ module sources
! calculate J²
!
db(:,:,:) = tmp(inz,inx,:,:,:)**2 + tmp(inz,iny,:,:,:)**2 &
+ tmp(inz,inz,:,:,:)**2
db(:,:,:) = tmp(inz,inx,:,:,:)**2 &
+ tmp(inz,iny,:,:,:)**2 &
+ tmp(inz,inz,:,:,:)**2
! add the second resistive source term to the energy equation, i.e.
! d/dt E + ∇.F = η J²
!
du(ien,:,:,:) = du(ien,:,:,:) + resistivity * db(:,:,:)
pdata%du(ien,:,:,:) = pdata%du(ien,:,:,:) + resistivity * db(:,:,:)
end if ! energy equation present
@ -761,7 +768,7 @@ module sources
! add extra source terms
!
if (associated(update_extra_sources)) &
call update_extra_sources(pdata, t, dt, du(:,:,:,:))
call update_extra_sources(t, dt, pdata)
100 continue