Merge branch 'master' into reconnection

This commit is contained in:
Grzegorz Kowal 2021-11-24 13:23:24 -03:00
commit 8482edee56
4 changed files with 35 additions and 74 deletions

View File

@ -1595,7 +1595,7 @@ module boundaries
integer :: it, jt, kt
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: ecount
integer :: ecount = 0
integer :: l, p
! local arrays
@ -2688,7 +2688,7 @@ module boundaries
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: ecount
integer :: ecount = 0
integer :: l, p
! local arrays
@ -4019,7 +4019,7 @@ module boundaries
#endif /* NDIMS == 3 */
#ifdef MPI
integer :: sproc = 0, rproc = 0
integer :: ecount
integer :: ecount = 0
integer :: l, p
! local arrays

View File

@ -2456,7 +2456,6 @@ module evolution
use blocks , only : block_data, list_data
use boundaries , only : boundary_fluxes
use coordinates, only : nb, ne
use equations , only : errors, ibp, cmax
use helpers , only : print_message
use sources , only : update_sources
@ -2465,15 +2464,16 @@ module evolution
type(block_data), pointer :: pdata
logical :: test
logical :: test, cond
integer :: nrej, i, status
real(kind=8) :: tm, dtm, dh, fc
real(kind=8) :: tm, dtm, fc
character(len=*), parameter :: loc = 'EVOLUTION:evolve_ssprk2_m()'
!-------------------------------------------------------------------------------
!
test = .true.
cond = .true.
nrej = 0
! at the entry point we assume the previous solution of conserved variables U(n)
@ -2593,10 +2593,12 @@ module evolution
fc = product(errs(:)**betas(:))
fc = 1.0d+00 + chi * atan((fc - 1.0d+00) / chi)
dte = dt * fc
cond = fc > fac .or. nrej >= mrej
100 continue
cond = cond .and. status == 0
if ((fc > fac .or. nrej >= mrej) .and. status == 0) then
if (cond) then
test = .false.
errs(3) = errs(2)
@ -2679,7 +2681,6 @@ module evolution
use blocks , only : block_data, list_data
use boundaries , only : boundary_fluxes
use coordinates, only : nb, ne
use equations , only : errors, ibp, cmax
use helpers , only : print_message
use sources , only : update_sources
@ -2688,7 +2689,7 @@ module evolution
type(block_data), pointer :: pdata
logical :: test
logical :: test, cond
integer :: nrej, i, status
real(kind=8) :: tm, dtm, dh, fc
@ -2700,6 +2701,7 @@ module evolution
!-------------------------------------------------------------------------------
!
test = .true.
cond = .true.
nrej = 0
! at the entry point we assume the previous solution of conserved variables U(n)
@ -2841,10 +2843,12 @@ module evolution
fc = product(errs(:)**betas(:))
fc = 1.0d+00 + chi * atan((fc - 1.0d+00) / chi)
dte = dt * fc
cond = fc > fac .or. nrej >= mrej
100 continue
cond = cond .and. status == 0
if ((fc > fac .or. nrej >= mrej) .and. status == 0) then
if (cond) then
test = .false.
errs(3) = errs(2)
@ -2934,7 +2938,7 @@ module evolution
integer , save :: i1, i2, i3, i4, n, m
real(kind=8), save :: f1, f2, f3, f4
logical :: test
logical :: test, cond
integer :: nrej, i, status
real(kind=8) :: tm, dtm, dh, fc
@ -2965,6 +2969,7 @@ module evolution
end if
test = .true.
cond = .true.
nrej = 0
! at the entry point we assume the previous solution of conserved variables U(n)
@ -3155,10 +3160,12 @@ module evolution
fc = product(errs(:)**betas(:))
fc = 1.0d+00 + chi * atan((fc - 1.0d+00) / chi)
dte = dt * fc
cond = fc > fac .or. nrej >= mrej
100 continue
cond = cond .and. status == 0
if ((fc > fac .or. nrej >= mrej) .and. status == 0) then
if (cond) then
test = .false.
errs(3) = errs(2)
@ -3242,8 +3249,8 @@ module evolution
type(block_data), pointer :: pdata
logical :: test
integer :: i, l, nrej, status
logical :: test, cond
integer :: i, nrej, status
real(kind=8) :: tm, dtm, fc
character(len=*), parameter :: loc = 'EVOLUTION:evolve_3sstarplus()'
@ -3251,6 +3258,7 @@ module evolution
!-------------------------------------------------------------------------------
!
test = .true.
cond = .true.
nrej = 0
! at the entry point we assume the previous solution of conserved variables U(n)
@ -3403,10 +3411,12 @@ module evolution
fc = product(errs(:)**betas(:))
fc = 1.0d+00 + chi * atan((fc - 1.0d+00) / chi)
dte = dt * fc
cond = fc > fac .or. nrej >= mrej
100 continue
cond = cond .and. status == 0
if ((fc > fac .or. nrej >= mrej) .and. status == 0) then
if (cond) then
test = .false.
errs(3) = errs(2)

View File

@ -106,8 +106,6 @@ module mesh
character(len=64) :: problem = "none"
character(len=*), parameter :: loc = 'MESH::initialize_mesh()'
!-------------------------------------------------------------------------------
!
status = 0
@ -149,7 +147,6 @@ module mesh
!
subroutine finalize_mesh(status)
use mpitools , only : master
use refinement, only : finalize_refinement
implicit none
@ -225,7 +222,7 @@ module mesh
#endif /* DEBUG */
use coordinates, only : minlev, maxlev
use helpers , only : print_section, print_message
use mpitools , only : master, nproc, nprocs, npmax, nodes, lprocs
use mpitools , only : master, nproc, npmax, nodes, lprocs
use refinement , only : check_refinement_criterion
implicit none
@ -602,10 +599,8 @@ module mesh
#ifdef MPI
use blocks , only : block_meta, block_data, list_meta
use blocks , only : get_nleafs, nregs
use blocks , only : get_nleafs
use blocks , only : append_datablock, remove_datablock, link_blocks
use coordinates , only : nn => bcells
use equations , only : nv
use mpitools , only : nprocs, npmax, nproc, nodes, lprocs
use mpitools , only : send_array, receive_array
#endif /* MPI */
@ -1524,10 +1519,6 @@ module mesh
use blocks , only : append_datablock, remove_datablock, link_blocks
#endif /* MPI */
use coordinates, only : toplev
#ifdef MPI
use coordinates, only : nn => bcells
use equations , only : nv
#endif /* MPI */
use helpers , only : print_message
#ifdef MPI
use mpitools , only : nprocs, nproc

View File

@ -2797,30 +2797,20 @@ module schemes
!
subroutine riemann_hd_iso_roe(ql, qr, ul, ur, fl, fr, cl, cr, f)
! include external procedures
!
use equations, only : idn, ivx, ivy, ivz
use equations, only : idn, ivx, ivz
use equations, only : eigensystem_roe
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
real(kind=8), dimension(:,:), intent(in) :: ql, qr, ul, ur, fl, fr, cl, cr
real(kind=8), dimension(:,:), intent(out) :: f
! local variables
!
integer :: nf, i, p
real(kind=8) :: sdl, sdr, sds
! local arrays to store the states
!
real(kind=8), dimension(size(ql,1)) :: qi, ci, al
real(kind=8), dimension(size(ql,1),size(ql,1)) :: li, ri
!
!-------------------------------------------------------------------------------
!
! get the number of fluxes
@ -2918,30 +2908,20 @@ module schemes
!
subroutine riemann_hd_adi_roe(ql, qr, ul, ur, fl, fr, cl, cr, f)
! include external procedures
!
use equations, only : idn, ivx, ivy, ivz, ipr, ien
use equations, only : idn, ivx, ivz, ipr, ien
use equations, only : eigensystem_roe
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
real(kind=8), dimension(:,:), intent(in) :: ql, qr, ul, ur, fl, fr, cl, cr
real(kind=8), dimension(:,:), intent(out) :: f
! local variables
!
integer :: nf, i, p
real(kind=8) :: sdl, sdr, sds
! local arrays to store the states
!
real(kind=8), dimension(size(ql,1)) :: qi, ci, al
real(kind=8), dimension(size(ql,1),size(ql,1)) :: li, ri
!
!-------------------------------------------------------------------------------
!
! get the number of fluxes
@ -3040,31 +3020,21 @@ module schemes
!
subroutine riemann_mhd_iso_roe(ql, qr, ul, ur, fl, fr, cl, cr, f)
! include external procedures
!
use equations, only : idn, ivx, ivy, ivz, imx, imy, imz, ibx, iby, ibz, ibp
use equations, only : idn, ivx, ivz, imx, imy, imz, ibx, iby, ibz, ibp
use equations, only : eigensystem_roe
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
real(kind=8), dimension(:,:), intent(in) :: ql, qr, ul, ur, fl, fr, cl, cr
real(kind=8), dimension(:,:), intent(out) :: f
! local variables
!
integer :: nf, i, p
real(kind=8) :: sdl, sdr, sds
real(kind=8) :: xx, yy
! local arrays to store the states
!
real(kind=8), dimension(size(ql,1)) :: qi, ci, al
real(kind=8), dimension(size(ql,1),size(ql,1)) :: li, ri
!
!-------------------------------------------------------------------------------
!
! get the number of fluxes
@ -3194,33 +3164,23 @@ module schemes
!
subroutine riemann_mhd_adi_roe(ql, qr, ul, ur, fl, fr, cl, cr, f)
! include external procedures
!
use equations, only : idn, ivx, ivy, ivz, imx, imy, imz, ipr, ien
use equations, only : idn, ivx, ivz, imx, imy, imz, ipr, ien
use equations, only : ibx, iby, ibz, ibp
use equations, only : eigensystem_roe
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
real(kind=8), dimension(:,:), intent(in) :: ql, qr, ul, ur, fl, fr, cl, cr
real(kind=8), dimension(:,:), intent(out) :: f
! local variables
!
integer :: nf, i, p
real(kind=8) :: sdl, sdr, sds
real(kind=8) :: xx, yy
real(kind=8) :: pml, pmr
! local arrays to store the states
!
real(kind=8), dimension(size(ql,1)) :: qi, ci, al
real(kind=8), dimension(size(ql,1),size(ql,1)) :: li, ri
!
!-------------------------------------------------------------------------------
!
! get the number of fluxes