2012-07-27 16:18:02 -03:00
|
|
|
|
!!******************************************************************************
|
|
|
|
|
!!
|
|
|
|
|
!! This file is part of the AMUN source code, a program to perform
|
|
|
|
|
!! Newtonian or relativistic magnetohydrodynamical simulations on uniform or
|
|
|
|
|
!! adaptive mesh.
|
|
|
|
|
!!
|
2021-02-04 17:35:04 -03:00
|
|
|
|
!! Copyright (C) 2008-2021 Grzegorz Kowal <grzegorz@amuncode.org>
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!!
|
|
|
|
|
!! This program is free software: you can redistribute it and/or modify
|
|
|
|
|
!! it under the terms of the GNU General Public License as published by
|
|
|
|
|
!! the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
!! (at your option) any later version.
|
|
|
|
|
!!
|
|
|
|
|
!! This program is distributed in the hope that it will be useful,
|
|
|
|
|
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
!! GNU General Public License for more details.
|
|
|
|
|
!!
|
|
|
|
|
!! You should have received a copy of the GNU General Public License
|
|
|
|
|
!! along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
!!
|
|
|
|
|
!!******************************************************************************
|
|
|
|
|
!!
|
|
|
|
|
!! module: EQUATIONS
|
|
|
|
|
!!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!! This module provides interface for the systems of equations. Any set of
|
|
|
|
|
!! equations gives us some basic informations, such as the number of variables,
|
|
|
|
|
!! the primitive and conservative variable definitions, the conversion between
|
|
|
|
|
!! those variables, the flux and characteristic speeds defined in terms of
|
|
|
|
|
!! primitive variables. All this information is provided by this module.
|
|
|
|
|
!!
|
|
|
|
|
!! In order to implement a new set of equations, we need to:
|
|
|
|
|
!!
|
|
|
|
|
!! 1) define the number of independent variables (or equations) nv;
|
|
|
|
|
!! 2) define the variable indices and names (both primitive and conservative);
|
|
|
|
|
!! 3) provide subroutines for primitive-conservative variable conversion and
|
|
|
|
|
!! point them to corresponding pointers;
|
|
|
|
|
!! 4) provide a subroutine to calculate physical fluxes and characteristic
|
|
|
|
|
!! speeds;
|
|
|
|
|
!! 5) provide a subroutine to calculate the maximum speed;
|
|
|
|
|
!! 6) optionally, define and read all physical constants related to a given
|
|
|
|
|
!! system;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!!
|
|
|
|
|
!!******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
module equations
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! the number of variables, fluxes and passive scalars
|
2018-08-29 23:25:11 -03:00
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
integer(kind=4), save :: nv = 0
|
|
|
|
|
integer(kind=4), save :: nf = 0
|
|
|
|
|
integer(kind=4), save :: ns = 0
|
2018-08-29 23:25:11 -03:00
|
|
|
|
|
|
|
|
|
! interfaces for procedure pointers
|
|
|
|
|
!
|
|
|
|
|
interface
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_iface(q, u, s)
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2018-08-29 23:25:11 -03:00
|
|
|
|
end subroutine
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_iface(u, q, s)
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2018-08-29 23:25:11 -03:00
|
|
|
|
end subroutine
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_iface(q, u, f, c)
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2018-08-29 23:25:11 -03:00
|
|
|
|
end subroutine
|
|
|
|
|
function maxspeed_iface(qq) result(maxspeed)
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2018-08-29 23:25:11 -03:00
|
|
|
|
real(kind=8) :: maxspeed
|
|
|
|
|
end function
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_iface(qq, um, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out):: um, cm
|
2022-01-06 22:44:21 -03:00
|
|
|
|
end subroutine
|
2018-08-29 23:25:11 -03:00
|
|
|
|
subroutine esystem_roe_iface(x, y, q, c, r, l)
|
2019-02-05 18:10:07 -02:00
|
|
|
|
real(kind=8) , intent(in) :: x, y
|
|
|
|
|
real(kind=8), dimension(:) , intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:) , intent(inout) :: c
|
|
|
|
|
real(kind=8), dimension(:,:), intent(inout) :: l, r
|
2018-08-29 23:25:11 -03:00
|
|
|
|
end subroutine
|
|
|
|
|
subroutine nr_iterate_iface(mm, bb, mb, en, dn, w, vv, info)
|
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
|
|
|
|
logical , intent(out) :: info
|
|
|
|
|
end subroutine
|
|
|
|
|
end interface
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! pointers to the conversion procedures
|
|
|
|
|
!
|
2018-08-29 23:25:11 -03:00
|
|
|
|
procedure(prim2cons_iface) , pointer, save :: prim2cons => null()
|
|
|
|
|
procedure(cons2prim_iface) , pointer, save :: cons2prim => null()
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! pointer to the flux procedure
|
|
|
|
|
!
|
2018-08-29 23:25:11 -03:00
|
|
|
|
procedure(fluxspeed_iface) , pointer, save :: fluxspeed => null()
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! pointer to the maxspeed procedure
|
|
|
|
|
!
|
2018-08-29 23:25:11 -03:00
|
|
|
|
procedure(maxspeed_iface) , pointer, save :: maxspeed => null()
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2022-01-07 15:38:54 -03:00
|
|
|
|
procedure(get_maximum_speeds_iface), pointer, save :: &
|
|
|
|
|
get_maximum_speeds => null()
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2014-03-06 12:59:51 -03:00
|
|
|
|
! pointer to the Roe eigensystem procedure
|
|
|
|
|
!
|
2018-08-29 23:25:11 -03:00
|
|
|
|
procedure(esystem_roe_iface), pointer, save :: eigensystem_roe => null()
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! pointer to the variable conversion method
|
|
|
|
|
!
|
2018-08-29 23:25:11 -03:00
|
|
|
|
procedure(nr_iterate_iface) , pointer, save :: nr_iterate => null()
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! the system of equations and the equation of state
|
|
|
|
|
!
|
|
|
|
|
character(len=32), save :: eqsys = "hydrodynamic"
|
|
|
|
|
character(len=32), save :: eos = "adiabatic"
|
|
|
|
|
|
2019-01-30 12:20:18 -02:00
|
|
|
|
! the flag indicating if the set of equations is relativistic or magnetized
|
2019-01-29 15:54:02 -02:00
|
|
|
|
!
|
|
|
|
|
logical , save :: relativistic = .false.
|
2019-01-30 12:20:18 -02:00
|
|
|
|
logical , save :: magnetized = .false.
|
2019-01-29 15:54:02 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! the variable conversion method
|
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
character(len=32), save :: c2p = "1Dw"
|
|
|
|
|
|
|
|
|
|
! the names of equations and methods
|
|
|
|
|
!
|
|
|
|
|
character(len=80), save :: name_eqsys = ""
|
|
|
|
|
character(len=80), save :: name_eos = ""
|
|
|
|
|
character(len=80), save :: name_c2p = ""
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2014-05-29 11:32:27 -03:00
|
|
|
|
! direction indices
|
|
|
|
|
!
|
|
|
|
|
integer(kind=4) , save :: inx = 1, iny = 2, inz = 3
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! variable indices
|
|
|
|
|
!
|
|
|
|
|
integer(kind=4) , save :: idn = -1
|
|
|
|
|
integer(kind=4) , save :: ivx = -1, ivy = -1, ivz = -1
|
|
|
|
|
integer(kind=4) , save :: imx = -1, imy = -1, imz = -1
|
|
|
|
|
integer(kind=4) , save :: ibx = -1, iby = -1, ibz = -1
|
|
|
|
|
integer(kind=4) , save :: ibp = -1
|
|
|
|
|
integer(kind=4) , save :: ipr = -1, ien = -1
|
2019-10-02 12:28:33 -03:00
|
|
|
|
integer(kind=4) , save :: isl = -1, isu = -1
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! variable names
|
|
|
|
|
!
|
|
|
|
|
character(len=4), dimension(:), allocatable, save :: pvars, cvars
|
|
|
|
|
|
2015-04-25 11:49:51 -03:00
|
|
|
|
! variable boundary values
|
|
|
|
|
!
|
|
|
|
|
real(kind=8), dimension(:,:,:), allocatable, save :: qpbnd
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
! adiabatic heat ratio
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
real(kind=8), save :: adiabatic_index = 5.0d+00 / 3.0d+00
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! additional adiabatic parameters
|
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
real(kind=8), save :: gammam1 = 2.0d+00 / 3.0d+00, gammam1i = 1.5d+00
|
|
|
|
|
real(kind=8), save :: gammaxi = 2.0d+00 / 5.0d+00
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! isothermal speed of sound and its second power
|
|
|
|
|
!
|
2020-04-20 13:09:16 -03:00
|
|
|
|
real(kind=8), save :: csnd = 1.0d+00, csnd2 = 1.0d+00
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! maximum speeds in the system
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
real(kind=8), save :: cmax = 0.0d+00, cmax2 = 0.0d+00
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8), save :: umax = 0.0d+00, cglm = 0.0d+00
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! the lower limits for density and pressure to be treated as physical
|
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
real(kind=8), save :: dmin = 1.0d-16, pmin = 1.0d-16
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2015-02-19 18:57:42 -02:00
|
|
|
|
! the upper limits for the Lorentz factor and corresponding |v|²
|
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
real(kind=8), save :: lmax = 1.0d+06
|
|
|
|
|
real(kind=8), save :: vmax = 0.999999999999d+00
|
2015-02-19 18:57:42 -02:00
|
|
|
|
|
2014-04-29 12:45:54 -03:00
|
|
|
|
! the upper bound for the sonic Mach number
|
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
real(kind=8), save :: msmax = 1.0d+03
|
|
|
|
|
real(kind=8), save :: msfac = 3.0d-06 / 5.0d+00
|
2014-04-29 12:45:54 -03:00
|
|
|
|
|
2015-02-14 17:20:03 -02:00
|
|
|
|
! the tolerance for Newton-Raphson interative method, the maximum number of
|
|
|
|
|
! iterations and the number of extra iterations for polishing
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
real(kind=8), save :: tol = 1.0d-10
|
|
|
|
|
integer , save :: nrmax = 100
|
|
|
|
|
integer , save :: nrext = 2
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2018-08-21 23:02:51 -03:00
|
|
|
|
! flag for unphysical cells correction, the maximum distance of neighbors for
|
|
|
|
|
! averaging region, and the minimum number of cells for averaging
|
2014-04-29 12:45:54 -03:00
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
logical , save :: fix_unphysical_cells = .false.
|
|
|
|
|
integer , save :: ngavg = 2
|
|
|
|
|
integer , save :: npavg = 4
|
|
|
|
|
|
2020-02-21 22:23:25 +07:00
|
|
|
|
! the variable indices for update_flux() from module SCHEMES
|
2020-02-21 20:59:59 +07:00
|
|
|
|
!
|
|
|
|
|
integer, dimension(:,:), allocatable :: ivars
|
2014-04-29 12:45:54 -03:00
|
|
|
|
|
2020-02-21 22:23:25 +07:00
|
|
|
|
! the variable positivity indicator
|
|
|
|
|
!
|
|
|
|
|
logical, dimension(:), allocatable :: positive
|
|
|
|
|
|
2020-08-28 21:30:56 -03:00
|
|
|
|
! the array of maximum errors for conservative variables
|
|
|
|
|
!
|
|
|
|
|
real(kind=8), dimension(:), allocatable :: errors
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! by default everything is private
|
|
|
|
|
!
|
|
|
|
|
private
|
|
|
|
|
|
|
|
|
|
! declare public variables and subroutines
|
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
public :: initialize_equations, finalize_equations, print_equations
|
2020-02-20 16:24:33 +07:00
|
|
|
|
public :: cons2prim, prim2cons, fluxspeed
|
|
|
|
|
public :: prim2cons_hd_iso, fluxspeed_hd_iso
|
|
|
|
|
public :: prim2cons_hd_adi, fluxspeed_hd_adi
|
|
|
|
|
public :: prim2cons_mhd_iso, fluxspeed_mhd_iso
|
|
|
|
|
public :: prim2cons_mhd_adi, fluxspeed_mhd_adi
|
|
|
|
|
public :: prim2cons_srhd_adi, fluxspeed_srhd_adi
|
|
|
|
|
public :: prim2cons_srmhd_adi, fluxspeed_srmhd_adi
|
2022-01-06 22:44:21 -03:00
|
|
|
|
public :: maxspeed, reset_maxspeed, get_maximum_speeds
|
2014-03-06 12:59:51 -03:00
|
|
|
|
public :: eigensystem_roe
|
2013-12-10 20:56:37 -02:00
|
|
|
|
public :: update_primitive_variables
|
2018-01-16 09:57:23 -02:00
|
|
|
|
public :: fix_unphysical_cells, correct_unphysical_states
|
2020-08-16 16:41:28 -03:00
|
|
|
|
public :: adiabatic_index, relativistic, magnetized
|
2014-08-26 07:10:48 -03:00
|
|
|
|
public :: csnd, csnd2
|
2022-01-07 15:38:54 -03:00
|
|
|
|
public :: cmax, cmax2, umax, cglm
|
2019-10-02 12:28:33 -03:00
|
|
|
|
public :: nv, nf, ns
|
2014-05-29 11:32:27 -03:00
|
|
|
|
public :: inx, iny, inz
|
2013-12-10 21:36:35 -02:00
|
|
|
|
public :: idn, ivx, ivy, ivz, imx, imy, imz
|
|
|
|
|
public :: ibx, iby, ibz, ibp, ipr, ien
|
2019-10-02 12:28:33 -03:00
|
|
|
|
public :: isl, isu
|
2013-12-11 00:16:22 -02:00
|
|
|
|
public :: eqsys, eos
|
2013-12-11 17:54:39 -02:00
|
|
|
|
public :: pvars, cvars
|
2015-04-25 11:49:51 -03:00
|
|
|
|
public :: qpbnd
|
2020-08-28 21:30:56 -03:00
|
|
|
|
public :: ivars, positive, errors
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
|
|
|
|
!
|
|
|
|
|
contains
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
2013-12-11 00:16:22 -02:00
|
|
|
|
!!
|
|
|
|
|
!!*** PUBLIC SUBROUTINES *****************************************************
|
|
|
|
|
!!
|
|
|
|
|
!===============================================================================
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! subroutine INITIALIZE_EQUATIONS:
|
|
|
|
|
! -------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine initiate the module by setting module parameters and subroutine
|
|
|
|
|
! pointers.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
! system - the equation system
|
|
|
|
|
! state - the equation of state
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! verbose - a logical flag turning the information printing;
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! status - an integer flag for error return value;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
subroutine initialize_equations(system, state, verbose, status)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! include external procedures and variables
|
|
|
|
|
!
|
2019-01-28 21:23:55 -02:00
|
|
|
|
use parameters, only : get_parameter
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! subroutine arguments
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
character(len=32), intent(in) :: system, state
|
|
|
|
|
logical , intent(in) :: verbose
|
|
|
|
|
integer , intent(out) :: status
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
integer :: p
|
|
|
|
|
character(len=32) :: unphysical_fix = "off"
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2019-02-08 15:28:23 -02:00
|
|
|
|
!
|
|
|
|
|
status = 0
|
|
|
|
|
|
2019-01-28 20:21:38 -02:00
|
|
|
|
! set the system of equations
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
eqsys = system
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-01-28 20:21:38 -02:00
|
|
|
|
! set the equation of state
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
eos = state
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! get the number of passive scalars
|
|
|
|
|
!
|
|
|
|
|
call get_parameter("nscalars" , ns )
|
|
|
|
|
ns = min(ns, 100)
|
|
|
|
|
|
2015-02-14 17:20:03 -02:00
|
|
|
|
! get the primitive variable solver
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
call get_parameter("primitive_solver", c2p)
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! depending on the system of equations initialize the module variables
|
|
|
|
|
!
|
|
|
|
|
select case(trim(eqsys))
|
|
|
|
|
|
|
|
|
|
!--- HYDRODYNAMICS ---
|
|
|
|
|
!
|
|
|
|
|
case("hd", "HD", "hydro", "HYDRO", "hydrodynamic", "HYDRODYNAMIC")
|
|
|
|
|
|
|
|
|
|
! the name of equation system
|
|
|
|
|
!
|
|
|
|
|
name_eqsys = "HD"
|
2015-06-24 16:12:25 -03:00
|
|
|
|
eqsys = "hd"
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of density, and velocity and momenta components
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
idn = 1
|
|
|
|
|
ivx = 2
|
|
|
|
|
ivy = 3
|
|
|
|
|
ivz = 4
|
|
|
|
|
imx = 2
|
|
|
|
|
imy = 3
|
|
|
|
|
imz = 4
|
|
|
|
|
|
|
|
|
|
! depending on the equation of state complete the initialization
|
|
|
|
|
!
|
|
|
|
|
select case(trim(eos))
|
|
|
|
|
|
|
|
|
|
case("iso", "ISO", "isothermal", "ISOTHERMAL")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
name_eos = "isothermal"
|
|
|
|
|
eos = "iso"
|
|
|
|
|
|
|
|
|
|
! initialize the number of variables:
|
|
|
|
|
!
|
|
|
|
|
! - 1 component of density
|
|
|
|
|
! - 3 components of velocity
|
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
nv = 4
|
|
|
|
|
|
|
|
|
|
! allocate the variable indices
|
|
|
|
|
!
|
|
|
|
|
allocate(ivars(NDIMS,nv), stat = status)
|
|
|
|
|
|
|
|
|
|
! fill up the variable indices
|
|
|
|
|
!
|
|
|
|
|
ivars(1,:) = (/ idn, ivx, ivy, ivz /)
|
|
|
|
|
ivars(2,:) = (/ idn, ivy, ivz, ivx /)
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
ivars(3,:) = (/ idn, ivz, ivx, ivy /)
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! set pointers to subroutines
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
prim2cons => prim2cons_hd_iso
|
|
|
|
|
cons2prim => cons2prim_hd_iso
|
|
|
|
|
fluxspeed => fluxspeed_hd_iso
|
|
|
|
|
maxspeed => maxspeed_hd_iso
|
|
|
|
|
eigensystem_roe => esystem_roe_hd_iso
|
|
|
|
|
get_maximum_speeds => get_maximum_speeds_hd_iso
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
case("adi", "ADI", "adiabatic", "ADIABATIC")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
|
|
|
|
name_eos = "adiabatic"
|
2015-06-24 16:15:43 -03:00
|
|
|
|
eos = "adi"
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of pressure and total energy
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
ipr = 5
|
|
|
|
|
ien = 5
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the number of variables:
|
|
|
|
|
!
|
|
|
|
|
! - 1 component of density
|
|
|
|
|
! - 3 components of velocity
|
|
|
|
|
! - 1 component of pressure
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
nv = 5
|
|
|
|
|
|
|
|
|
|
! allocate the variable indices
|
|
|
|
|
!
|
|
|
|
|
allocate(ivars(NDIMS,nv), stat = status)
|
|
|
|
|
|
|
|
|
|
! fill up the variable indices
|
|
|
|
|
!
|
|
|
|
|
ivars(1,:) = (/ idn, ivx, ivy, ivz, ipr /)
|
|
|
|
|
ivars(2,:) = (/ idn, ivy, ivz, ivx, ipr /)
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
ivars(3,:) = (/ idn, ivz, ivx, ivy, ipr /)
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! set pointers to subroutines
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
prim2cons => prim2cons_hd_adi
|
|
|
|
|
cons2prim => cons2prim_hd_adi
|
|
|
|
|
fluxspeed => fluxspeed_hd_adi
|
|
|
|
|
maxspeed => maxspeed_hd_adi
|
|
|
|
|
eigensystem_roe => esystem_roe_hd_adi
|
|
|
|
|
get_maximum_speeds => get_maximum_speeds_hd_adi
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! warn about the unimplemented equation of state
|
|
|
|
|
!
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected equation of state is not " // &
|
|
|
|
|
"implemented for HD: '" // trim(eos) // "'."
|
|
|
|
|
write(*,"(1x,a)") "Available equations of state: 'iso', 'adi'."
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! proceed if everything is fine
|
|
|
|
|
!
|
|
|
|
|
if (status == 0) then
|
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! initialize the number of fluxes
|
|
|
|
|
!
|
|
|
|
|
nf = nv
|
|
|
|
|
|
|
|
|
|
! set passive scalars index limits and update the number of variables
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0) then
|
|
|
|
|
isl = nv + 1
|
|
|
|
|
isu = nv + ns
|
|
|
|
|
nv = isu
|
|
|
|
|
end if
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! allocate arrays for variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
allocate(pvars(nv), cvars(nv), stat = status)
|
|
|
|
|
|
|
|
|
|
if (status == 0) then
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! fill in the primitive variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
pvars(idn) = 'dens'
|
|
|
|
|
pvars(ivx) = 'velx'
|
|
|
|
|
pvars(ivy) = 'vely'
|
|
|
|
|
pvars(ivz) = 'velz'
|
|
|
|
|
if (ipr > 0) pvars(ipr) = 'pres'
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! fill in the conservative variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
cvars(idn) = 'dens'
|
|
|
|
|
cvars(imx) = 'momx'
|
|
|
|
|
cvars(imy) = 'momy'
|
|
|
|
|
cvars(imz) = 'momz'
|
|
|
|
|
if (ien > 0) cvars(ien) = 'ener'
|
|
|
|
|
|
|
|
|
|
end if ! status
|
|
|
|
|
end if ! status
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
!--- MAGNETOHYDRODYNAMICS ---
|
|
|
|
|
!
|
|
|
|
|
case("mhd", "MHD", "magnetohydrodynamic", "MAGNETOHYDRODYNAMIC")
|
|
|
|
|
|
|
|
|
|
! the name of equation system
|
|
|
|
|
!
|
|
|
|
|
name_eqsys = "MHD"
|
2015-06-24 16:12:25 -03:00
|
|
|
|
eqsys = "mhd"
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-01-30 12:20:18 -02:00
|
|
|
|
! set magnetized flag
|
|
|
|
|
!
|
|
|
|
|
magnetized = .true.
|
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of density, and velocity and momenta components
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
idn = 1
|
|
|
|
|
ivx = 2
|
|
|
|
|
ivy = 3
|
|
|
|
|
ivz = 4
|
|
|
|
|
imx = 2
|
|
|
|
|
imy = 3
|
|
|
|
|
imz = 4
|
|
|
|
|
|
|
|
|
|
! depending on the equation of state complete the initialization
|
|
|
|
|
!
|
|
|
|
|
select case(trim(eos))
|
|
|
|
|
|
|
|
|
|
case("iso", "ISO", "isothermal", "ISOTHERMAL")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
name_eos = "isothermal"
|
|
|
|
|
eos = "iso"
|
|
|
|
|
|
|
|
|
|
! initialize the indices of magnetic field components and divergence potential
|
|
|
|
|
!
|
|
|
|
|
ibx = 5
|
|
|
|
|
iby = 6
|
|
|
|
|
ibz = 7
|
|
|
|
|
ibp = 8
|
|
|
|
|
|
|
|
|
|
! initialize the number of variables:
|
|
|
|
|
!
|
|
|
|
|
! - 1 component of density
|
|
|
|
|
! - 3 components of velocity
|
|
|
|
|
! - 3 components of magnetic field
|
|
|
|
|
! - 1 component of divergence potential
|
|
|
|
|
!
|
|
|
|
|
nv = 8
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-21 20:59:59 +07:00
|
|
|
|
! allocate the variable indices
|
|
|
|
|
!
|
|
|
|
|
allocate(ivars(NDIMS,nv), stat = status)
|
|
|
|
|
|
|
|
|
|
! fill up the variable indices
|
|
|
|
|
!
|
|
|
|
|
ivars(1,:) = (/ idn, ivx, ivy, ivz, ibx, iby, ibz, ibp /)
|
|
|
|
|
ivars(2,:) = (/ idn, ivy, ivz, ivx, iby, ibz, ibx, ibp /)
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
ivars(3,:) = (/ idn, ivz, ivx, ivy, ibz, ibx, iby, ibp /)
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! set pointers to the subroutines
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
prim2cons => prim2cons_mhd_iso
|
|
|
|
|
cons2prim => cons2prim_mhd_iso
|
|
|
|
|
fluxspeed => fluxspeed_mhd_iso
|
|
|
|
|
maxspeed => maxspeed_mhd_iso
|
|
|
|
|
eigensystem_roe => esystem_roe_mhd_iso
|
|
|
|
|
get_maximum_speeds => get_maximum_speeds_mhd_iso
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
case("adi", "ADI", "adiabatic", "ADIABATIC")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
|
|
|
|
name_eos = "adiabatic"
|
2015-06-24 16:15:43 -03:00
|
|
|
|
eos = "adi"
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of pressure, total energy, magnetic field components
|
|
|
|
|
! and divergence potential
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
ipr = 5
|
|
|
|
|
ien = 5
|
|
|
|
|
ibx = 6
|
|
|
|
|
iby = 7
|
|
|
|
|
ibz = 8
|
|
|
|
|
ibp = 9
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the number of variables:
|
|
|
|
|
!
|
|
|
|
|
! - 1 component of density
|
|
|
|
|
! - 3 components of velocity
|
|
|
|
|
! - 1 component of pressure
|
|
|
|
|
! - 3 components of magnetic field
|
|
|
|
|
! - 1 component of magnetic divergence potential
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
nv = 9
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-02-21 20:59:59 +07:00
|
|
|
|
! allocate the variable indices
|
|
|
|
|
!
|
|
|
|
|
allocate(ivars(NDIMS,nv), stat = status)
|
|
|
|
|
|
|
|
|
|
! fill up the variable indices
|
|
|
|
|
!
|
|
|
|
|
ivars(1,:) = (/ idn, ivx, ivy, ivz, ipr, ibx, iby, ibz, ibp /)
|
|
|
|
|
ivars(2,:) = (/ idn, ivy, ivz, ivx, ipr, iby, ibz, ibx, ibp /)
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
ivars(3,:) = (/ idn, ivz, ivx, ivy, ipr, ibz, ibx, iby, ibp /)
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! set pointers to subroutines
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
prim2cons => prim2cons_mhd_adi
|
|
|
|
|
cons2prim => cons2prim_mhd_adi
|
|
|
|
|
fluxspeed => fluxspeed_mhd_adi
|
|
|
|
|
maxspeed => maxspeed_mhd_adi
|
|
|
|
|
eigensystem_roe => esystem_roe_mhd_adi
|
|
|
|
|
get_maximum_speeds => get_maximum_speeds_mhd_adi
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected equation of state is not " // &
|
|
|
|
|
"implemented for MHD: '" // trim(eos) // "'."
|
|
|
|
|
write(*,"(1x,a)") "Available equations of state: 'iso', 'adi'."
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! proceed if everything is fine
|
|
|
|
|
!
|
|
|
|
|
if (status == 0) then
|
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! initialize the number of fluxes
|
|
|
|
|
!
|
|
|
|
|
nf = nv
|
|
|
|
|
|
|
|
|
|
! set passive scalars index limits and update the number of variables
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0) then
|
|
|
|
|
isl = nv + 1
|
|
|
|
|
isu = nv + ns
|
|
|
|
|
nv = isu
|
|
|
|
|
end if
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! allocate arrays for variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
allocate(pvars(nv), cvars(nv), stat = status)
|
|
|
|
|
|
|
|
|
|
if (status == 0) then
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! fill in the primitive variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
pvars(idn) = 'dens'
|
|
|
|
|
pvars(ivx) = 'velx'
|
|
|
|
|
pvars(ivy) = 'vely'
|
|
|
|
|
pvars(ivz) = 'velz'
|
2020-02-19 01:56:26 -03:00
|
|
|
|
if (ipr > 0) pvars(ipr) = 'pres'
|
2019-02-08 15:28:23 -02:00
|
|
|
|
pvars(ibx) = 'magx'
|
|
|
|
|
pvars(iby) = 'magy'
|
|
|
|
|
pvars(ibz) = 'magz'
|
|
|
|
|
pvars(ibp) = 'bpsi'
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! fill in the conservative variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
cvars(idn) = 'dens'
|
|
|
|
|
cvars(imx) = 'momx'
|
|
|
|
|
cvars(imy) = 'momy'
|
|
|
|
|
cvars(imz) = 'momz'
|
2020-02-19 01:56:26 -03:00
|
|
|
|
if (ien > 0) cvars(ien) = 'ener'
|
2019-02-08 15:28:23 -02:00
|
|
|
|
cvars(ibx) = 'magx'
|
|
|
|
|
cvars(iby) = 'magy'
|
|
|
|
|
cvars(ibz) = 'magz'
|
|
|
|
|
cvars(ibp) = 'bpsi'
|
|
|
|
|
|
|
|
|
|
end if ! status
|
|
|
|
|
end if ! status
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!--- SPECIAL RELATIVITY HYDRODYNAMICS ---
|
|
|
|
|
!
|
|
|
|
|
case("srhd", "SRHD")
|
|
|
|
|
|
|
|
|
|
! the name of equation system
|
|
|
|
|
!
|
|
|
|
|
name_eqsys = "Special Relativity HD"
|
2015-06-24 16:12:25 -03:00
|
|
|
|
eqsys = "srhd"
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! set relativistic flag
|
|
|
|
|
!
|
|
|
|
|
relativistic = .true.
|
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of density, and velocity and momenta components
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
idn = 1
|
|
|
|
|
ivx = 2
|
|
|
|
|
ivy = 3
|
|
|
|
|
ivz = 4
|
|
|
|
|
imx = 2
|
|
|
|
|
imy = 3
|
|
|
|
|
imz = 4
|
|
|
|
|
|
|
|
|
|
! depending on the equation of state complete the initialization
|
|
|
|
|
!
|
|
|
|
|
select case(trim(eos))
|
|
|
|
|
|
|
|
|
|
case("adi", "ADI", "adiabatic", "ADIABATIC")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
name_eos = "adiabatic"
|
|
|
|
|
eos = "adi"
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of pressure and total energy
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
ipr = 5
|
|
|
|
|
ien = 5
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the number of variables:
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! - 1 component of density
|
|
|
|
|
! - 3 components of velocity
|
|
|
|
|
! - 1 component of pressure
|
|
|
|
|
!
|
|
|
|
|
nv = 5
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2020-02-21 20:59:59 +07:00
|
|
|
|
! allocate the variable indices
|
|
|
|
|
!
|
|
|
|
|
allocate(ivars(NDIMS,nv), stat = status)
|
|
|
|
|
|
|
|
|
|
! fill up the variable indices
|
|
|
|
|
!
|
|
|
|
|
ivars(1,:) = (/ idn, ivx, ivy, ivz, ipr /)
|
|
|
|
|
ivars(2,:) = (/ idn, ivy, ivz, ivx, ipr /)
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
ivars(3,:) = (/ idn, ivz, ivx, ivy, ipr /)
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! set pointers to subroutines
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
prim2cons => prim2cons_srhd_adi
|
|
|
|
|
cons2prim => cons2prim_srhd_adi
|
|
|
|
|
fluxspeed => fluxspeed_srhd_adi
|
|
|
|
|
maxspeed => maxspeed_srhd_adi
|
|
|
|
|
get_maximum_speeds => get_maximum_speeds_srhd_adi
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! warn about the unimplemented equation of state
|
|
|
|
|
!
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected equation of state is not " // &
|
|
|
|
|
"implemented for SR-HD: '" // trim(eos) // "'."
|
|
|
|
|
write(*,"(1x,a)") "Available equations of state: 'adi'."
|
2015-02-06 09:02:56 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
|
! choose the conserved to primitive variable conversion method
|
|
|
|
|
!
|
|
|
|
|
select case(trim(c2p))
|
|
|
|
|
|
2015-02-19 17:44:14 -02:00
|
|
|
|
case("1Dw", "1dw", "1DW", "1D(w)", "1D(W)")
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2015-02-19 11:38:16 -02:00
|
|
|
|
name_c2p = "1D(W)"
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! set pointer to the conversion method
|
|
|
|
|
!
|
|
|
|
|
nr_iterate => nr_iterate_srhd_adi_1dw
|
|
|
|
|
|
2015-02-19 17:38:47 -02:00
|
|
|
|
case("2dwv", "2Dwv", "2D(w,v)", "2D(W,v)")
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2015-02-19 11:38:16 -02:00
|
|
|
|
name_c2p = "2D(W,v²)"
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
|
|
|
|
! set pointer to the conversion method
|
|
|
|
|
!
|
2015-02-19 11:38:16 -02:00
|
|
|
|
nr_iterate => nr_iterate_srhd_adi_2dwv
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2015-02-19 17:44:14 -02:00
|
|
|
|
case("2dwu", "2Dwu", "2D(w,u)", "2D(W,u)")
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
|
|
|
|
name_c2p = "2D(W,u²)"
|
|
|
|
|
|
|
|
|
|
! set pointer to the conversion method
|
|
|
|
|
!
|
|
|
|
|
nr_iterate => nr_iterate_srhd_adi_2dwu
|
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! warn about the unimplemented method
|
|
|
|
|
!
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected conversion method is not " // &
|
|
|
|
|
"implemented " // trim(c2p) // " for SR-HD."
|
|
|
|
|
write(*,"(1x,a)") "Available conversions: '1Dw', '2Dwv', '2Dwu'."
|
2015-02-06 09:02:56 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! proceed if everything is fine
|
|
|
|
|
!
|
|
|
|
|
if (status == 0) then
|
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! initialize the number of fluxes
|
|
|
|
|
!
|
|
|
|
|
nf = nv
|
|
|
|
|
|
|
|
|
|
! set passive scalars index limits and update the number of variables
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0) then
|
|
|
|
|
isl = nv + 1
|
|
|
|
|
isu = nv + ns
|
|
|
|
|
nv = isu
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! allocate arrays for variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
allocate(pvars(nv), cvars(nv), stat = status)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
if (status == 0) then
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! fill in the primitive variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
pvars(idn) = 'dens'
|
|
|
|
|
pvars(ivx) = 'velx'
|
|
|
|
|
pvars(ivy) = 'vely'
|
|
|
|
|
pvars(ivz) = 'velz'
|
|
|
|
|
if (ipr > 0) pvars(ipr) = 'pres'
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! fill in the conservative variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
cvars(idn) = 'dens'
|
|
|
|
|
cvars(imx) = 'momx'
|
|
|
|
|
cvars(imy) = 'momy'
|
|
|
|
|
cvars(imz) = 'momz'
|
|
|
|
|
if (ien > 0) cvars(ien) = 'ener'
|
|
|
|
|
|
|
|
|
|
end if ! status
|
|
|
|
|
end if ! status
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!--- SPECIAL RELATIVITY MAGNETOHYDRODYNAMICS ---
|
|
|
|
|
!
|
|
|
|
|
case("srmhd", "SRMHD")
|
|
|
|
|
|
|
|
|
|
! the name of equation system
|
|
|
|
|
!
|
|
|
|
|
name_eqsys = "Special Relativity MHD"
|
2015-06-24 16:12:25 -03:00
|
|
|
|
eqsys = "srmhd"
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! set relativistic flag
|
|
|
|
|
!
|
|
|
|
|
relativistic = .true.
|
|
|
|
|
|
2019-01-30 12:20:18 -02:00
|
|
|
|
! set magnetized flag
|
|
|
|
|
!
|
|
|
|
|
magnetized = .true.
|
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of density, and velocity and momenta components
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
idn = 1
|
|
|
|
|
ivx = 2
|
|
|
|
|
ivy = 3
|
|
|
|
|
ivz = 4
|
|
|
|
|
imx = 2
|
|
|
|
|
imy = 3
|
|
|
|
|
imz = 4
|
|
|
|
|
|
|
|
|
|
! depending on the equation of state complete the initialization
|
|
|
|
|
!
|
|
|
|
|
select case(trim(eos))
|
|
|
|
|
|
|
|
|
|
case("adi", "ADI", "adiabatic", "ADIABATIC")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
name_eos = "adiabatic"
|
|
|
|
|
eos = "adi"
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the indices of pressure, total energy, magnetic field components
|
|
|
|
|
! and divergence potential
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2020-02-19 01:56:26 -03:00
|
|
|
|
ipr = 5
|
|
|
|
|
ien = 5
|
|
|
|
|
ibx = 6
|
|
|
|
|
iby = 7
|
|
|
|
|
ibz = 8
|
|
|
|
|
ibp = 9
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2020-02-19 01:56:26 -03:00
|
|
|
|
! initialize the number of variables:
|
|
|
|
|
!
|
|
|
|
|
! - 1 component of density
|
|
|
|
|
! - 3 components of velocity
|
|
|
|
|
! - 1 component of pressure
|
|
|
|
|
! - 3 components of magnetic field
|
|
|
|
|
! - 1 component of magnetic divergence potential
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2020-02-21 20:59:59 +07:00
|
|
|
|
nv = 9
|
|
|
|
|
|
|
|
|
|
! allocate the variable indices
|
|
|
|
|
!
|
|
|
|
|
allocate(ivars(NDIMS,nv), stat = status)
|
|
|
|
|
|
|
|
|
|
! fill up the variable indices
|
|
|
|
|
!
|
|
|
|
|
ivars(1,:) = (/ idn, ivx, ivy, ivz, ipr, ibx, iby, ibz, ibp /)
|
|
|
|
|
ivars(2,:) = (/ idn, ivy, ivz, ivx, ipr, iby, ibz, ibx, ibp /)
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
ivars(3,:) = (/ idn, ivz, ivx, ivy, ipr, ibz, ibx, iby, ibp /)
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! set pointers to subroutines
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
prim2cons => prim2cons_srmhd_adi
|
|
|
|
|
cons2prim => cons2prim_srmhd_adi
|
|
|
|
|
fluxspeed => fluxspeed_srmhd_adi
|
|
|
|
|
maxspeed => maxspeed_srmhd_adi
|
|
|
|
|
get_maximum_speeds => get_maximum_speeds_srmhd_adi
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! warn about the unimplemented equation of state
|
|
|
|
|
!
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected equation of state is not " // &
|
|
|
|
|
"implemented for SR-MHD: '" // trim(eos) // "'."
|
|
|
|
|
write(*,"(1x,a)") "Available equations of state: 'adi'."
|
2015-02-17 11:28:40 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
|
|
|
|
! choose the conserved to primitive variable conversion method
|
|
|
|
|
!
|
|
|
|
|
select case(trim(c2p))
|
|
|
|
|
|
2015-02-20 13:32:47 -02:00
|
|
|
|
case("1Dw", "1dw", "1DW", "1D(w)", "1D(W)")
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2015-02-20 13:32:47 -02:00
|
|
|
|
name_c2p = "1D(W)"
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! set pointer to the conversion method
|
|
|
|
|
!
|
|
|
|
|
nr_iterate => nr_iterate_srmhd_adi_1dw
|
|
|
|
|
|
2015-02-20 13:32:47 -02:00
|
|
|
|
case("2dwv", "2Dwv", "2D(w,v)", "2D(W,v)")
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
2015-02-20 13:32:47 -02:00
|
|
|
|
name_c2p = "2D(W,v²)"
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
|
|
|
|
! set pointer to the conversion method
|
|
|
|
|
!
|
2015-02-20 13:32:47 -02:00
|
|
|
|
nr_iterate => nr_iterate_srmhd_adi_2dwv
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-28 14:22:00 -03:00
|
|
|
|
case("2dwu", "2Dwu", "2D(w,u)", "2D(W,u)")
|
|
|
|
|
|
|
|
|
|
! the type of equation of state
|
|
|
|
|
!
|
|
|
|
|
name_c2p = "2D(W,u²)"
|
|
|
|
|
|
|
|
|
|
! set pointer to the conversion method
|
|
|
|
|
!
|
|
|
|
|
nr_iterate => nr_iterate_srmhd_adi_2dwu
|
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! warn about the unimplemented method
|
|
|
|
|
!
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected conversion method is not " // &
|
|
|
|
|
"implemented " // trim(c2p) // " for SR-MHD."
|
|
|
|
|
write(*,"(1x,a)") "Available conversions: '1Dw', '2Dwv', '2Dwu'."
|
2015-02-17 11:28:40 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! proceed if everything is fine
|
|
|
|
|
!
|
|
|
|
|
if (status == 0) then
|
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! initialize the number of fluxes
|
|
|
|
|
!
|
|
|
|
|
nf = nv
|
|
|
|
|
|
|
|
|
|
! set passive scalars index limits and update the number of variables
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0) then
|
|
|
|
|
isl = nv + 1
|
|
|
|
|
isu = nv + ns
|
|
|
|
|
nv = isu
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! allocate arrays for variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
allocate(pvars(nv), cvars(nv), stat = status)
|
|
|
|
|
|
|
|
|
|
if (status == 0) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! fill in the primitive variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
pvars(idn) = 'dens'
|
|
|
|
|
pvars(ivx) = 'velx'
|
|
|
|
|
pvars(ivy) = 'vely'
|
|
|
|
|
pvars(ivz) = 'velz'
|
2020-02-19 01:56:26 -03:00
|
|
|
|
if (ipr > 0) pvars(ipr) = 'pres'
|
2019-02-08 15:28:23 -02:00
|
|
|
|
pvars(ibx) = 'magx'
|
|
|
|
|
pvars(iby) = 'magy'
|
|
|
|
|
pvars(ibz) = 'magz'
|
|
|
|
|
pvars(ibp) = 'bpsi'
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! fill in the conservative variable names
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
cvars(idn) = 'dens'
|
|
|
|
|
cvars(imx) = 'momx'
|
|
|
|
|
cvars(imy) = 'momy'
|
|
|
|
|
cvars(imz) = 'momz'
|
2020-02-19 01:56:26 -03:00
|
|
|
|
if (ien > 0) cvars(ien) = 'ener'
|
2019-02-08 15:28:23 -02:00
|
|
|
|
cvars(ibx) = 'magx'
|
|
|
|
|
cvars(iby) = 'magy'
|
|
|
|
|
cvars(ibz) = 'magz'
|
|
|
|
|
cvars(ibp) = 'bpsi'
|
|
|
|
|
|
|
|
|
|
end if ! status
|
|
|
|
|
end if ! status
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!--- EQUATION SYSTEM NOT IMPLEMENTED ---
|
|
|
|
|
!
|
|
|
|
|
case default
|
|
|
|
|
|
|
|
|
|
if (verbose) then
|
2019-02-08 15:28:23 -02:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(1x,a)") "ERROR!"
|
|
|
|
|
write(*,"(1x,a)") "The selected equation system is not " // &
|
|
|
|
|
"implemented: " // trim(eqsys) // "."
|
|
|
|
|
write(*,"(1x,a)") "Available equation systems: 'hd' 'mhd'" // &
|
|
|
|
|
", 'srhd', 'srmhd'."
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end if
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 1
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
end select
|
|
|
|
|
|
2020-08-22 18:32:08 -03:00
|
|
|
|
! allocate positivity indicators
|
|
|
|
|
!
|
|
|
|
|
allocate(positive(nv), stat = status)
|
|
|
|
|
|
|
|
|
|
if (status == 0) then
|
|
|
|
|
|
|
|
|
|
positive( : ) = .false.
|
|
|
|
|
positive(idn) = .true.
|
|
|
|
|
if (ipr > 0) positive(ipr) = .true.
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
2020-08-28 21:30:56 -03:00
|
|
|
|
! allocate an array for errors
|
|
|
|
|
!
|
|
|
|
|
allocate(errors(nf), stat = status)
|
|
|
|
|
|
|
|
|
|
if (status == 0) errors(:) = 0.0d+00
|
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! proceed if everything is fine
|
|
|
|
|
!
|
|
|
|
|
if (status == 0) then
|
|
|
|
|
|
2019-10-02 12:28:33 -03:00
|
|
|
|
! generate the passive scalar names
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
write(pvars(p), '("ps",i2.2)') p - isl
|
|
|
|
|
write(cvars(p), '("ps",i2.2)') p - isl
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
! obtain the adiabatic specific heat ratio
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
call get_parameter("adiabatic_index", adiabatic_index)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! calculate additional parameters
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
gammam1 = adiabatic_index - 1.0d+00
|
2019-02-08 15:28:23 -02:00
|
|
|
|
gammam1i = 1.0d+00 / gammam1
|
2020-08-16 16:41:28 -03:00
|
|
|
|
gammaxi = gammam1 / adiabatic_index
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! obtain the isothermal sound speed
|
|
|
|
|
!
|
2020-08-16 16:46:27 -03:00
|
|
|
|
call get_parameter("sound_speed", csnd )
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! calculate additional parameters
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
csnd2 = csnd * csnd
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2015-04-25 11:49:51 -03:00
|
|
|
|
! allocate array for the boundary values
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
allocate(qpbnd(nv,3,2), stat = status)
|
|
|
|
|
|
|
|
|
|
if (status == 0) then
|
2015-04-25 11:49:51 -03:00
|
|
|
|
|
2015-04-25 12:14:58 -03:00
|
|
|
|
! set the boundary values
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
do p = 1, nv
|
2015-04-25 12:14:58 -03:00
|
|
|
|
|
|
|
|
|
! set the initial boundary values (1.0 for density and pressure, 0.0 otherwise)
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
if (pvars(p) == "dens" .or. pvars(p) == "pres") then
|
|
|
|
|
qpbnd(p,:,:) = 1.0d+00
|
|
|
|
|
else
|
|
|
|
|
qpbnd(p,:,:) = 0.0d+00
|
|
|
|
|
end if
|
2015-04-25 12:14:58 -03:00
|
|
|
|
|
|
|
|
|
! read the boundary values from the parameter file
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
call get_parameter(pvars(p) // "_bnd_xl", qpbnd(p,1,1))
|
|
|
|
|
call get_parameter(pvars(p) // "_bnd_xr", qpbnd(p,1,2))
|
|
|
|
|
call get_parameter(pvars(p) // "_bnd_yl", qpbnd(p,2,1))
|
|
|
|
|
call get_parameter(pvars(p) // "_bnd_yr", qpbnd(p,2,2))
|
|
|
|
|
call get_parameter(pvars(p) // "_bnd_zl", qpbnd(p,3,1))
|
|
|
|
|
call get_parameter(pvars(p) // "_bnd_zr", qpbnd(p,3,2))
|
2015-04-25 12:14:58 -03:00
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
end do ! over all variables
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2015-02-19 18:57:42 -02:00
|
|
|
|
! get the minimum allowed density and pressure in the system, and the maximum
|
|
|
|
|
! Lorentz factor for special relativity
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
call get_parameter("dmin", dmin)
|
|
|
|
|
call get_parameter("pmin", pmin)
|
|
|
|
|
call get_parameter("lmax", lmax)
|
2015-02-19 18:57:42 -02:00
|
|
|
|
|
|
|
|
|
! calculate the maximum speed corresponding to the maximum Lorentz factor
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
vmax = 1.0d+00 - 1.0d+00 / lmax**2
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2014-04-29 12:45:54 -03:00
|
|
|
|
! get the upper bound for the sonic Mach number
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
call get_parameter("msmax", msmax)
|
2014-04-29 12:45:54 -03:00
|
|
|
|
|
|
|
|
|
! calculate the sonic Mach number factor
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
msfac = 1.0d+00 / (adiabatic_index * msmax**2)
|
2019-02-08 15:28:23 -02:00
|
|
|
|
|
|
|
|
|
! get the tolerance
|
|
|
|
|
!
|
|
|
|
|
call get_parameter("tolerance" , tol )
|
|
|
|
|
|
|
|
|
|
! get the maximum number of Newton-Raphson method iterations
|
|
|
|
|
!
|
|
|
|
|
call get_parameter("nr_maxit" , nrmax)
|
|
|
|
|
call get_parameter("nr_extra" , nrext)
|
2014-04-29 12:45:54 -03:00
|
|
|
|
|
2018-01-16 10:01:40 -02:00
|
|
|
|
! get the state correction flags
|
2014-04-29 12:45:54 -03:00
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
call get_parameter("fix_unphysical_cells", unphysical_fix)
|
2014-04-29 12:45:54 -03:00
|
|
|
|
|
2018-01-16 10:01:40 -02:00
|
|
|
|
! check if the correction of unphysical cells is on
|
2014-04-29 12:45:54 -03:00
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
select case(trim(unphysical_fix))
|
|
|
|
|
case ("on", "ON", "t", "T", "y", "Y", "true", "TRUE", "yes", "YES")
|
|
|
|
|
fix_unphysical_cells = .true.
|
|
|
|
|
case default
|
|
|
|
|
fix_unphysical_cells = .false.
|
|
|
|
|
end select
|
2014-04-29 12:45:54 -03:00
|
|
|
|
|
2018-08-21 23:02:51 -03:00
|
|
|
|
! get parameters for unphysical cells correction
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
call get_parameter("ngavg", ngavg)
|
|
|
|
|
call get_parameter("npavg", npavg)
|
2018-08-21 23:02:51 -03:00
|
|
|
|
|
|
|
|
|
! correct the above parameters to reasonable values
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
ngavg = max(1, ngavg)
|
|
|
|
|
npavg = max(2, npavg)
|
|
|
|
|
|
|
|
|
|
end if ! status
|
|
|
|
|
end if ! status
|
2018-08-21 23:02:51 -03:00
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine initialize_equations
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine FINALIZE_EQUATIONS:
|
|
|
|
|
! -----------------------------
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine releases memory used by the module.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! status - an integer flag for error return value;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
subroutine finalize_equations(status)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! subroutine arguments
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
integer, intent(out) :: status
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2019-02-08 15:28:23 -02:00
|
|
|
|
status = 0
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2013-12-12 14:39:18 -02:00
|
|
|
|
! release the procedure pointers
|
|
|
|
|
!
|
|
|
|
|
nullify(prim2cons)
|
|
|
|
|
nullify(cons2prim)
|
|
|
|
|
nullify(fluxspeed)
|
2014-03-06 12:59:51 -03:00
|
|
|
|
nullify(maxspeed)
|
|
|
|
|
nullify(eigensystem_roe)
|
2013-12-12 14:39:18 -02:00
|
|
|
|
|
2020-02-21 20:59:59 +07:00
|
|
|
|
! deallocate variable indices
|
|
|
|
|
!
|
|
|
|
|
if (allocated(ivars)) deallocate(ivars, stat = status)
|
|
|
|
|
|
2019-02-08 15:28:23 -02:00
|
|
|
|
! deallocate variable name arrays
|
|
|
|
|
!
|
|
|
|
|
if (allocated(pvars)) deallocate(pvars, stat = status)
|
|
|
|
|
if (allocated(cvars)) deallocate(cvars, stat = status)
|
|
|
|
|
|
|
|
|
|
! deallocate boundary values array
|
|
|
|
|
!
|
|
|
|
|
if (allocated(qpbnd)) deallocate(qpbnd, stat = status)
|
|
|
|
|
|
2020-02-21 22:23:25 +07:00
|
|
|
|
! deallocate positivity indicator
|
|
|
|
|
!
|
|
|
|
|
if (allocated(positive)) deallocate(positive, stat = status)
|
|
|
|
|
|
2020-08-28 21:30:56 -03:00
|
|
|
|
! deallocate the array for errors
|
|
|
|
|
!
|
|
|
|
|
if (allocated(errors)) deallocate(errors, stat = status)
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine finalize_equations
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-01-29 15:54:02 -02:00
|
|
|
|
! subroutine PRINT_EQUATIONS:
|
|
|
|
|
! --------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine prints module parameters.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! verbose - a logical flag turning the information printing;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine print_equations(verbose)
|
|
|
|
|
|
|
|
|
|
! include external procedures and variables
|
|
|
|
|
!
|
2019-01-30 18:55:41 -02:00
|
|
|
|
use helpers, only : print_section, print_parameter
|
2019-01-29 15:54:02 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! subroutine arguments
|
|
|
|
|
!
|
|
|
|
|
logical, intent(in) :: verbose
|
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2019-01-30 18:48:10 -02:00
|
|
|
|
character(len= 80) :: sfmt
|
|
|
|
|
character(len=255) :: msg
|
2019-01-29 15:54:02 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
if (verbose) then
|
|
|
|
|
|
2019-01-30 18:48:10 -02:00
|
|
|
|
call print_section(verbose, "Physics")
|
2019-10-02 14:03:12 -03:00
|
|
|
|
call print_parameter(verbose, "equation system" , name_eqsys)
|
|
|
|
|
call print_parameter(verbose, "equation of state" , name_eos )
|
2022-01-01 12:39:49 -03:00
|
|
|
|
if (ipr > 0) then
|
|
|
|
|
call print_parameter(verbose, "adiabatic index", adiabatic_index)
|
|
|
|
|
else
|
|
|
|
|
call print_parameter(verbose, "sound speed" , csnd)
|
|
|
|
|
end if
|
2019-10-02 14:03:12 -03:00
|
|
|
|
call print_parameter(verbose, "number of variables" , nv )
|
|
|
|
|
call print_parameter(verbose, "number of fluxes" , nf )
|
|
|
|
|
call print_parameter(verbose, "number of passive scalars", ns )
|
2019-01-30 18:48:10 -02:00
|
|
|
|
write(sfmt,"(a,i0,a)") "(", nv, "(1x,a))"
|
|
|
|
|
write(msg,sfmt) cvars
|
|
|
|
|
call print_parameter(verbose, "conservative variables", msg )
|
|
|
|
|
write(msg,sfmt) pvars
|
|
|
|
|
call print_parameter(verbose, "primitive variables" , msg )
|
2019-01-29 15:54:02 -02:00
|
|
|
|
if (relativistic) then
|
2019-01-30 18:48:10 -02:00
|
|
|
|
call print_parameter(verbose, "variable conversion" , name_c2p )
|
2019-01-29 15:54:02 -02:00
|
|
|
|
end if
|
|
|
|
|
if (fix_unphysical_cells) then
|
2019-01-30 18:48:10 -02:00
|
|
|
|
call print_parameter(verbose, "fix unphysical cells" , "on" )
|
|
|
|
|
call print_parameter(verbose, "ngavg" , ngavg )
|
|
|
|
|
call print_parameter(verbose, "npavg" , npavg )
|
2019-01-29 15:54:02 -02:00
|
|
|
|
else
|
2019-01-30 18:48:10 -02:00
|
|
|
|
call print_parameter(verbose, "fix unphysical cells" , "off" )
|
2019-01-29 15:54:02 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine print_equations
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine RESET_MAXSPEED:
|
|
|
|
|
! -------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine resets the maximum speed in the domain to zero.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine reset_maxspeed()
|
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! reset the maximum speed
|
|
|
|
|
!
|
|
|
|
|
cmax = 0.0d+00
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine reset_maxspeed
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! function GET_MAXSPEED:
|
|
|
|
|
! -----------------
|
|
|
|
|
!
|
|
|
|
|
! Function returns the maximum speed in the domain.
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
real(kind=8) function get_maxspeed()
|
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! return the maximum speed
|
|
|
|
|
!
|
|
|
|
|
get_maxspeed = cmax
|
|
|
|
|
|
|
|
|
|
! return the value
|
|
|
|
|
!
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end function get_maxspeed
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! 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.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! uu - the input array of conservative variables;
|
|
|
|
|
! qq - the output array of primitive variables;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 12:51:23 -03:00
|
|
|
|
subroutine update_primitive_variables(uu, qq, status)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2020-08-06 18:31:14 -03:00
|
|
|
|
use coordinates, only : nn => bcells
|
2019-02-05 14:40:45 -02:00
|
|
|
|
use coordinates, only : nb, ne, nbl, neu
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(inout) :: uu
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(inout) :: qq
|
2021-11-09 12:51:23 -03:00
|
|
|
|
integer , intent(out) :: status
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2021-11-09 12:51:23 -03:00
|
|
|
|
status = 0
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
call cons2prim(uu(1:nv,nb:ne,j,k), qq(1:nv,nb:ne,j,k), status)
|
|
|
|
|
|
|
|
|
|
if (status /= 0) go to 100
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! j = nb, ne
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do ! k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do i = nbl, 1, -1
|
|
|
|
|
qq(1:nv, i,nb:ne,nb:ne) = qq(1:nv,nb,nb:ne,nb:ne)
|
2015-06-05 18:41:39 -03:00
|
|
|
|
end do
|
2019-02-05 14:40:45 -02:00
|
|
|
|
do i = neu, nn
|
|
|
|
|
qq(1:nv, i,nb:ne,nb:ne) = qq(1:nv,ne,nb:ne,nb:ne)
|
2015-06-05 18:41:39 -03:00
|
|
|
|
end do
|
2019-02-05 14:40:45 -02:00
|
|
|
|
do j = nbl, 1, -1
|
|
|
|
|
qq(1:nv, : , j,nb:ne) = qq(1:nv, : ,nb,nb:ne)
|
2015-06-05 18:41:39 -03:00
|
|
|
|
end do
|
2019-02-05 14:40:45 -02:00
|
|
|
|
do j = neu, nn
|
|
|
|
|
qq(1:nv, : , j,nb:ne) = qq(1:nv, : ,ne,nb:ne)
|
2015-06-05 18:41:39 -03:00
|
|
|
|
end do
|
2019-02-05 14:40:45 -02:00
|
|
|
|
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, : )
|
2015-06-05 18:41:39 -03:00
|
|
|
|
end do
|
2019-02-05 14:40:45 -02:00
|
|
|
|
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, : )
|
2015-06-05 18:41:39 -03:00
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine update_primitive_variables
|
|
|
|
|
!
|
2013-12-11 00:16:22 -02:00
|
|
|
|
!===============================================================================
|
2018-01-16 09:57:23 -02:00
|
|
|
|
!
|
|
|
|
|
! subroutine CORRECT_UNPHYSICAL_STATES:
|
|
|
|
|
! ------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine seeks for unphysical states (cells with negative density or
|
|
|
|
|
! pressure) and try to fix them by averaging their values from physical
|
|
|
|
|
! neighbours.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2018-08-23 18:05:00 -03:00
|
|
|
|
! it - the time step number;
|
2018-01-16 09:57:23 -02:00
|
|
|
|
! id - the block id where the states are being checked;
|
|
|
|
|
! qq - the output array of primitive variables;
|
|
|
|
|
! uu - the input array of conservative variables;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2018-08-23 18:05:00 -03:00
|
|
|
|
subroutine correct_unphysical_states(it, id, qq, uu)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use coordinates, only : nn => bcells
|
|
|
|
|
use helpers , only : print_message
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
integer(kind=4) , intent(in) :: it, id
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(inout) :: qq
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(inout) :: uu
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
2018-08-23 18:05:00 -03:00
|
|
|
|
character(len=255) :: msg, sfmt
|
|
|
|
|
character(len=16) :: sit, sid, snc
|
2018-01-16 09:57:23 -02:00
|
|
|
|
integer :: n, p, nc, np
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, il, iu
|
|
|
|
|
integer :: j, jl, ju
|
|
|
|
|
integer :: k
|
2020-08-15 01:28:28 -03:00
|
|
|
|
#if NDIMS == 3
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: kl, ku
|
2020-08-15 01:28:28 -03:00
|
|
|
|
#endif /* NDIMS == 3 */
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#if NDIMS == 3
|
2019-02-05 14:40:45 -02:00
|
|
|
|
logical, dimension(nn,nn,nn) :: physical
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#else /* NDIMS == 3 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
logical, dimension(nn,nn, 1) :: physical
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#endif /* NDIMS == 3 */
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
integer , dimension(:,:), allocatable :: idx
|
|
|
|
|
real(kind=8), dimension(:,:), allocatable :: q, u
|
|
|
|
|
|
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::correct_unphysical_states()'
|
2021-11-19 12:33:47 -03:00
|
|
|
|
|
2018-01-16 09:57:23 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2022-01-08 10:45:02 -03:00
|
|
|
|
np = 0
|
|
|
|
|
i = 1
|
|
|
|
|
il = 1
|
|
|
|
|
iu = 1
|
|
|
|
|
j = 1
|
|
|
|
|
jl = 1
|
|
|
|
|
ju = 1
|
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
kl = 1
|
|
|
|
|
ku = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
|
|
|
|
|
2018-01-16 09:57:23 -02:00
|
|
|
|
! search for negative density or pressure
|
|
|
|
|
!
|
|
|
|
|
physical(:,:,:) = qq(idn,:,:,:) > 0.0d+00
|
|
|
|
|
if (ipr > 0) then
|
|
|
|
|
physical(:,:,:) = physical(:,:,:) .and. qq(ipr,:,:,:) > 0.0d+00
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! apply averaging for unphysical states
|
|
|
|
|
!
|
|
|
|
|
if (.not. all(physical)) then
|
|
|
|
|
|
|
|
|
|
! count unphysical cells
|
|
|
|
|
!
|
|
|
|
|
nc = count(.not. physical)
|
|
|
|
|
|
|
|
|
|
! inform about the encountered unphysical states
|
|
|
|
|
!
|
2018-08-23 18:05:00 -03:00
|
|
|
|
write(sit,'(i15)') it
|
2018-01-17 08:41:57 -02:00
|
|
|
|
write(sid,'(i15)') id
|
|
|
|
|
write(snc,'(i15)') nc
|
2018-08-23 18:05:00 -03:00
|
|
|
|
sfmt = '("Unphysical cells in block ID:",a," (",a," counted)' &
|
|
|
|
|
// ' at time step ",a,".")'
|
|
|
|
|
write(msg,sfmt) trim(adjustl(sid)), trim(adjustl(snc)), trim(adjustl(sit))
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, msg)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
! allocate temporary vectors for unphysical states
|
|
|
|
|
!
|
|
|
|
|
allocate(q(nv,nc), u(nv,nc), idx(3,nc))
|
|
|
|
|
|
|
|
|
|
! iterate over block cells
|
|
|
|
|
!
|
|
|
|
|
n = 0
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#if NDIMS == 3
|
2019-02-05 14:40:45 -02:00
|
|
|
|
do k = 1, nn
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#endif /* NDIMS == 3 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
do j = 1, nn
|
|
|
|
|
do i = 1, nn
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
! fix unphysical states
|
|
|
|
|
!
|
|
|
|
|
if (.not. physical(i,j,k)) then
|
|
|
|
|
|
|
|
|
|
n = n + 1
|
|
|
|
|
|
|
|
|
|
idx(:,n) = (/ i, j, k /)
|
|
|
|
|
|
2018-01-17 08:41:57 -02:00
|
|
|
|
! increase the region until we find at least three physical cells, but no more
|
|
|
|
|
! than 4 cells away
|
2018-01-16 09:57:23 -02:00
|
|
|
|
!
|
|
|
|
|
np = 0
|
|
|
|
|
p = 1
|
2018-08-21 23:02:51 -03:00
|
|
|
|
do while (np <= npavg .and. p <= ngavg)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
il = max( 1, i - p)
|
2019-02-05 14:40:45 -02:00
|
|
|
|
iu = min(nn, i + p)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
jl = max( 1, j - p)
|
2019-02-05 14:40:45 -02:00
|
|
|
|
ju = min(nn, j + p)
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#if NDIMS == 3
|
2018-01-16 09:57:23 -02:00
|
|
|
|
kl = max( 1, k - p)
|
2019-02-05 14:40:45 -02:00
|
|
|
|
ku = min(nn, k + p)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
np = count(physical(il:iu,jl:ju,kl:ku))
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#else /* NDIMS == 3 */
|
|
|
|
|
|
|
|
|
|
np = count(physical(il:iu,jl:ju, 1 ))
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
p = p + 1
|
|
|
|
|
end do
|
|
|
|
|
|
|
|
|
|
! average primitive variables
|
|
|
|
|
!
|
2018-08-21 23:02:51 -03:00
|
|
|
|
if (np >= npavg) then
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
do p = 1, nv
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#if NDIMS == 3
|
2018-01-16 09:57:23 -02:00
|
|
|
|
q(p,n) = sum(qq(p,il:iu,jl:ju,kl:ku), &
|
|
|
|
|
physical(il:iu,jl:ju,kl:ku)) &
|
|
|
|
|
/ np
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#else /* NDIMS == 3 */
|
|
|
|
|
q(p,n) = sum(qq(p,il:iu,jl:ju, 1 ), &
|
|
|
|
|
physical(il:iu,jl:ju, 1 )) &
|
|
|
|
|
/ np
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2018-01-16 09:57:23 -02:00
|
|
|
|
end do
|
|
|
|
|
|
|
|
|
|
else
|
|
|
|
|
|
2018-08-21 22:45:49 -03:00
|
|
|
|
! limit density or pressure to minimum value, since the averaging over
|
|
|
|
|
! neighbours failed
|
2018-01-16 09:57:23 -02:00
|
|
|
|
!
|
2018-08-23 18:05:00 -03:00
|
|
|
|
msg = "Not sufficient number of physical neighbors!"
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, msg)
|
2018-08-23 18:05:00 -03:00
|
|
|
|
sfmt = '("Block ID:",a,", cell position = ( ",3(i4," ")," ).")'
|
|
|
|
|
write(msg,sfmt) trim(adjustl(sid)), i, j, k
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, msg)
|
|
|
|
|
write(msg,"('Q = ',10(1x,1es24.16e3))") qq(:,i,j,k)
|
|
|
|
|
call print_message(loc, msg)
|
2018-08-23 18:05:00 -03:00
|
|
|
|
msg = "Applying lower bounds for positive variables."
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, msg)
|
2018-08-21 22:45:49 -03:00
|
|
|
|
|
2019-10-03 22:17:09 -03:00
|
|
|
|
q(:,n) = qq(:,i,j,k)
|
2018-08-21 22:45:49 -03:00
|
|
|
|
q(idn ,n) = max(dmin, qq(idn,i,j,k))
|
|
|
|
|
if (ipr > 0) q(ipr,n) = max(pmin, qq(ipr,i,j,k))
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
end if ! not sufficient number of physical cells for averaging
|
|
|
|
|
|
|
|
|
|
end if ! not physical
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! i = 1, nn
|
|
|
|
|
end do ! j = 1, nn
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#if NDIMS == 3
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! k = 1, nn
|
2019-02-05 09:34:51 -02:00
|
|
|
|
#endif /* NDIMS == 3 */
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
! convert the vector of primitive variables to conservative ones
|
|
|
|
|
!
|
2019-10-03 22:17:09 -03:00
|
|
|
|
call prim2cons(q(:,1:nc), u(:,1:nc), .true.)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
|
|
|
|
|
! update block variables
|
|
|
|
|
!
|
|
|
|
|
do n = 1, nc
|
|
|
|
|
i = idx(1,n)
|
|
|
|
|
j = idx(2,n)
|
|
|
|
|
k = idx(3,n)
|
|
|
|
|
|
2019-10-03 22:17:09 -03:00
|
|
|
|
qq(:,i,j,k) = q(:,n)
|
|
|
|
|
uu(:,i,j,k) = u(:,n)
|
2018-01-16 09:57:23 -02:00
|
|
|
|
end do
|
|
|
|
|
|
|
|
|
|
! deallocate temporary vectors
|
|
|
|
|
!
|
|
|
|
|
deallocate(q, u, idx)
|
|
|
|
|
|
|
|
|
|
end if ! there are unphysical cells
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine correct_unphysical_states
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
2013-12-11 00:16:22 -02:00
|
|
|
|
!!
|
|
|
|
|
!!*** PRIVATE SUBROUTINES ****************************************************
|
|
|
|
|
!!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
! ISOTHERMAL HYDRODYNAMIC EQUATIONS
|
|
|
|
|
!
|
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine PRIM2CONS_HD_ISO:
|
|
|
|
|
! ---------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts primitive variables to their corresponding
|
|
|
|
|
! conservative representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the output array of conservative variables;
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! s - an optional flag indicating that passive scalars have
|
|
|
|
|
! to be calculated too;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_hd_iso(q, u, s)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
integer :: i, p
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
|
|
|
|
! iterate over all positions
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
u(idn,i) = q(idn,i)
|
|
|
|
|
u(imx,i) = q(idn,i) * q(ivx,i)
|
|
|
|
|
u(imy,i) = q(idn,i) * q(ivy,i)
|
|
|
|
|
u(imz,i) = q(idn,i) * q(ivz,i)
|
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
end do
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! update primitive passive scalars
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0 .and. present(s)) then
|
|
|
|
|
if (s) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
u(p,:) = q(p,:) * u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine prim2cons_hd_iso
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine CONS2PRIM_HD_ISO:
|
|
|
|
|
! ---------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts conservative variables to their corresponding
|
|
|
|
|
! primitive representation.
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! q - the output array of primitive variables;
|
2021-11-09 13:21:32 -03:00
|
|
|
|
! s - the status flag;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_hd_iso(u, q, s)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 0
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
do i = 1, size(u,2)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
if (u(idn,i) > 0.0d+00) then
|
|
|
|
|
q(idn,i) = u(idn,i)
|
|
|
|
|
q(ivx,i) = u(imx,i) / u(idn,i)
|
|
|
|
|
q(ivy,i) = u(imy,i) / u(idn,i)
|
|
|
|
|
q(ivz,i) = u(imz,i) / u(idn,i)
|
|
|
|
|
else
|
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
|
|
|
|
end if
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
end do
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
q(p,:) = u(p,:) / u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine cons2prim_hd_iso
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine FLUXSPEED_HD_ISO:
|
|
|
|
|
! ---------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine calculates physical fluxes and characteristic speeds from a
|
|
|
|
|
! given equation system.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! f - the output vector of fluxes;
|
|
|
|
|
! c - the output vector of left- and right-going characteristic speeds;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_hd_iso(q, u, f, c)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
integer :: i
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2015-12-10 07:07:10 -02:00
|
|
|
|
! calculate the hydrodynamic fluxes
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
f(idn,i) = u(imx,i)
|
|
|
|
|
f(imx,i) = q(ivx,i) * u(imx,i)
|
|
|
|
|
f(imy,i) = q(ivx,i) * u(imy,i)
|
|
|
|
|
f(imz,i) = q(ivx,i) * u(imz,i)
|
|
|
|
|
f(imx,i) = f(imx,i) + csnd2 * q(idn,i)
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
! calculate the characteristic speeds
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (present(c)) then
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = q(ivx,i) - csnd
|
|
|
|
|
c(2,i) = q(ivx,i) + csnd
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
end if
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine fluxspeed_hd_iso
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! function MAXSPEED_HD_ISO:
|
|
|
|
|
! ------------------------
|
|
|
|
|
!
|
|
|
|
|
! Function scans the variable array and returns the maximum speed in within.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the array of primitive variables;
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
function maxspeed_hd_iso(qq) result(maxspeed)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
use coordinates, only : nb, ne
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
real(kind=8) :: maxspeed
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: vv, v
|
2022-01-08 10:45:02 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
maxspeed = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! calculate the velocity amplitude
|
|
|
|
|
!
|
|
|
|
|
vv = sum(qq(ivx:ivz,i,j,k) * qq(ivx:ivz,i,j,k))
|
|
|
|
|
v = sqrt(vv)
|
|
|
|
|
|
|
|
|
|
! calculate the maximum speed
|
|
|
|
|
!
|
|
|
|
|
maxspeed = max(maxspeed, v + csnd)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! i = nb, ne
|
|
|
|
|
end do ! j = nb, ne
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do ! k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end function maxspeed_hd_iso
|
|
|
|
|
!
|
2014-03-06 12:59:51 -03:00
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! subroutine GET_MAXIMUM_SPEEDS_HD_ISO:
|
|
|
|
|
! ------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine determines the maximum characteristic speed and eigenvalue
|
|
|
|
|
! in the input array of primitive variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the input array of primitive variables;
|
|
|
|
|
! vm - the maximum physical speed;
|
2022-01-07 15:38:54 -03:00
|
|
|
|
! cm - the maximum eigenvalue;
|
2022-01-06 22:44:21 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_hd_iso(qq, vm, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
use coordinates, only : nb, ne
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out) :: vm, cm
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2022-01-06 22:44:21 -03:00
|
|
|
|
real(kind=8) :: vl, vu
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vm = 0.0d+00
|
2022-01-07 15:38:54 -03:00
|
|
|
|
cm = 0.0d+00
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2022-01-06 22:44:21 -03:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
|
|
|
|
vl = minval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vu = maxval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vm = max(vm, abs(vl), abs(vu))
|
2022-01-07 15:38:54 -03:00
|
|
|
|
cm = max(cm, abs(vl - csnd), abs(vu + csnd))
|
2022-01-06 22:44:21 -03:00
|
|
|
|
end do
|
|
|
|
|
end do
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine get_maximum_speeds_hd_iso
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2014-03-06 12:59:51 -03:00
|
|
|
|
! subroutine ESYSTEM_ROE_HD_ISO:
|
|
|
|
|
! -----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine computes eigenvalues and eigenvectors for a given set of
|
|
|
|
|
! equations and input variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2014-03-06 13:55:09 -03:00
|
|
|
|
! x - ratio of the perpendicular magnetic field component difference
|
|
|
|
|
! y - ratio of the density
|
2014-03-06 12:59:51 -03:00
|
|
|
|
! q - the intermediate Roe state vector;
|
|
|
|
|
! c - the vector of eigenvalues;
|
|
|
|
|
! r - the matrix of right eigenvectors;
|
|
|
|
|
! l - the matrix of left eigenvectors;
|
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! [1] Roe, P. L.
|
|
|
|
|
! "Approximate Riemann Solvers, Parameter Vectors, and Difference
|
|
|
|
|
! Schemes",
|
|
|
|
|
! Journal of Computational Physics, 1981, 43, pp. 357-372
|
|
|
|
|
! [2] Stone, J. M. & Gardiner, T. A.,
|
|
|
|
|
! "ATHENA: A New Code for Astrophysical MHD",
|
|
|
|
|
! The Astrophysical Journal Suplement Series, 2008, 178, pp. 137-177
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2014-03-06 13:55:09 -03:00
|
|
|
|
subroutine esystem_roe_hd_iso(x, y, q, c, r, l)
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 18:10:07 -02:00
|
|
|
|
real(kind=8) , intent(in) :: x, y
|
|
|
|
|
real(kind=8), dimension(:) , intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:) , intent(inout) :: c
|
|
|
|
|
real(kind=8), dimension(:,:), intent(inout) :: l, r
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 12:46:39 -03:00
|
|
|
|
logical , save :: first = .true.
|
|
|
|
|
real(kind=8), dimension(4,4), save :: lvec, rvec
|
2021-12-15 13:02:12 -03:00
|
|
|
|
!$omp threadprivate(first, lvec, rvec)
|
|
|
|
|
|
|
|
|
|
real(kind=8) :: vc
|
2021-12-15 12:46:39 -03:00
|
|
|
|
|
2014-03-06 12:59:51 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
if (first) then
|
2021-12-15 12:46:39 -03:00
|
|
|
|
lvec(:,:) = 0.0d+00
|
|
|
|
|
rvec(:,:) = 0.0d+00
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 13:02:12 -03:00
|
|
|
|
lvec(ivx,1) = - 5.0d-01 / csnd
|
|
|
|
|
lvec(ivy,2) = 1.0d+00
|
|
|
|
|
lvec(ivz,3) = 1.0d+00
|
|
|
|
|
lvec(ivx,4) = - lvec(ivx,1)
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 12:46:39 -03:00
|
|
|
|
rvec(1,idn) = 1.0d+00
|
|
|
|
|
rvec(2,ivy) = 1.0d+00
|
|
|
|
|
rvec(3,ivz) = 1.0d+00
|
|
|
|
|
rvec(4,idn) = 1.0d+00
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
|
|
|
|
first = .false.
|
2021-12-15 12:46:39 -03:00
|
|
|
|
end if
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 13:02:12 -03:00
|
|
|
|
! eigenvalues
|
2014-03-06 12:59:51 -03:00
|
|
|
|
!
|
2021-12-15 13:02:12 -03:00
|
|
|
|
c(1) = q(ivx) - csnd
|
|
|
|
|
c(2) = q(ivx)
|
|
|
|
|
c(3) = q(ivx)
|
|
|
|
|
c(4) = q(ivx) + csnd
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 13:02:12 -03:00
|
|
|
|
! update the varying elements of the left eigenvectors matrix
|
2014-03-06 12:59:51 -03:00
|
|
|
|
!
|
2021-12-15 13:02:12 -03:00
|
|
|
|
vc = 5.0d-01 * q(ivx) / csnd
|
|
|
|
|
lvec(idn,1) = 5.0d-01 + vc
|
2021-12-15 12:46:39 -03:00
|
|
|
|
lvec(idn,2) = - q(ivy)
|
|
|
|
|
lvec(idn,3) = - q(ivz)
|
2021-12-15 13:02:12 -03:00
|
|
|
|
lvec(idn,4) = 5.0d-01 - vc
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 13:02:12 -03:00
|
|
|
|
! update the varying elements of the right eigenvectors matrix
|
2014-03-06 12:59:51 -03:00
|
|
|
|
!
|
2021-12-15 12:46:39 -03:00
|
|
|
|
rvec(1,ivx) = c(1)
|
|
|
|
|
rvec(1,ivy) = q(ivy)
|
|
|
|
|
rvec(1,ivz) = q(ivz)
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
2021-12-15 12:46:39 -03:00
|
|
|
|
rvec(4,ivx) = c(4)
|
|
|
|
|
rvec(4,ivy) = q(ivy)
|
|
|
|
|
rvec(4,ivz) = q(ivz)
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
|
|
|
|
! copy matrices of eigenvectors
|
|
|
|
|
!
|
2021-12-15 12:46:39 -03:00
|
|
|
|
l(:,:) = lvec(:,:)
|
|
|
|
|
r(:,:) = rvec(:,:)
|
2014-03-06 12:59:51 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine esystem_roe_hd_iso
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
! ADIABATIC HYDRODYNAMIC EQUATIONS
|
|
|
|
|
!
|
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine PRIM2CONS_HD_ADI:
|
|
|
|
|
! ---------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts primitive variables to their corresponding
|
|
|
|
|
! conservative representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the output array of conservative variables;
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! s - an optional flag indicating that passive scalars have
|
|
|
|
|
! to be calculated too;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_hd_adi(q, u, s)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2014-08-04 09:17:56 -03:00
|
|
|
|
real(kind=8) :: ek, ei
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
|
|
|
|
! iterate over all positions
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
u(idn,i) = q(idn,i)
|
|
|
|
|
u(imx,i) = q(idn,i) * q(ivx,i)
|
|
|
|
|
u(imy,i) = q(idn,i) * q(ivy,i)
|
|
|
|
|
u(imz,i) = q(idn,i) * q(ivz,i)
|
2015-01-09 17:07:10 -02:00
|
|
|
|
ek = 0.5d+00 * (u(imx,i) * q(ivx,i) + u(imy,i) * q(ivy,i) &
|
|
|
|
|
+ u(imz,i) * q(ivz,i))
|
2013-12-10 20:56:37 -02:00
|
|
|
|
ei = gammam1i * q(ipr,i)
|
|
|
|
|
u(ien,i) = ei + ek
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
end do
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! update primitive passive scalars
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0 .and. present(s)) then
|
|
|
|
|
if (s) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
u(p,:) = q(p,:) * u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine prim2cons_hd_adi
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine CONS2PRIM_HD_ADI:
|
|
|
|
|
! ---------------------------
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine converts conservative variables to their corresponding
|
|
|
|
|
! primitive representation.
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! q - the output array of primitive variables;
|
2021-11-09 13:21:32 -03:00
|
|
|
|
! s - the status flag;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_hd_adi(u, q, s)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2015-01-11 15:59:41 -02:00
|
|
|
|
real(kind=8) :: ek, ei
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 0
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
do i = 1, size(u,2)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
if (u(idn,i) > 0.0d+00) then
|
|
|
|
|
q(idn,i) = u(idn,i)
|
|
|
|
|
q(ivx,i) = u(imx,i) / u(idn,i)
|
|
|
|
|
q(ivy,i) = u(imy,i) / u(idn,i)
|
|
|
|
|
q(ivz,i) = u(imz,i) / u(idn,i)
|
|
|
|
|
ek = 0.5d+00 * sum(u(imx:imz,i) * q(ivx:ivz,i))
|
|
|
|
|
ei = u(ien,i) - ek
|
|
|
|
|
if (ei > 0.0d+00) then
|
|
|
|
|
q(ipr,i) = gammam1 * ei
|
|
|
|
|
else
|
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
|
|
|
|
end if
|
|
|
|
|
else
|
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
|
|
|
|
end if
|
2019-02-05 15:48:42 -02:00
|
|
|
|
end do
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
q(p,:) = u(p,:) / u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine cons2prim_hd_adi
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine FLUXSPEED_HD_ADI:
|
|
|
|
|
! ---------------------------
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine calculates physical fluxes and characteristic speeds from a
|
|
|
|
|
! given equation system.
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! f - the output vector of fluxes;
|
|
|
|
|
! c - the output vector of left- and right-going characteristic speeds;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_hd_adi(q, u, f, c)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2015-02-05 22:07:19 -02:00
|
|
|
|
integer :: i
|
|
|
|
|
real(kind=8) :: cs
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2015-12-10 07:07:10 -02:00
|
|
|
|
! calculate the hydrodynamic fluxes
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
f(idn,i) = u(imx,i)
|
|
|
|
|
f(imx,i) = q(ivx,i) * u(imx,i)
|
|
|
|
|
f(imy,i) = q(ivx,i) * u(imy,i)
|
|
|
|
|
f(imz,i) = q(ivx,i) * u(imz,i)
|
|
|
|
|
f(imx,i) = f(imx,i) + q(ipr,i)
|
|
|
|
|
f(ien,i) = q(ivx,i) * (u(ien,i) + q(ipr,i))
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
! calculate the characteristic speeds
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (present(c)) then
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-08-16 16:41:28 -03:00
|
|
|
|
cs = sqrt(adiabatic_index * q(ipr,i) / q(idn,i))
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = q(ivx,i) - cs
|
|
|
|
|
c(2,i) = q(ivx,i) + cs
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
end if
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine fluxspeed_hd_adi
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! function MAXSPEED_HD_ADI:
|
|
|
|
|
! ------------------------
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Function scans the variable array and returns the maximum speed in within.
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the array of primitive variables;
|
|
|
|
|
!
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
function maxspeed_hd_adi(qq) result(maxspeed)
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
use coordinates, only : nb, ne
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
real(kind=8) :: maxspeed
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2013-12-10 20:56:37 -02:00
|
|
|
|
real(kind=8) :: vv, v, c
|
2022-01-08 10:45:02 -03:00
|
|
|
|
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
maxspeed = 0.0d+00
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
! calculate the velocity amplitude
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
vv = sum(qq(ivx:ivz,i,j,k) * qq(ivx:ivz,i,j,k))
|
2012-08-01 12:16:38 -03:00
|
|
|
|
v = sqrt(vv)
|
|
|
|
|
|
|
|
|
|
! calculate the adiabatic speed of sound
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c = sqrt(adiabatic_index * qq(ipr,i,j,k) / qq(idn,i,j,k))
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
! calculate the maximum speed
|
|
|
|
|
!
|
|
|
|
|
maxspeed = max(maxspeed, v + c)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! i = nb, ne
|
|
|
|
|
end do ! j = nb, ne
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do ! k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end function maxspeed_hd_adi
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
2014-03-06 13:16:57 -03:00
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! subroutine GET_MAXIMUM_SPEEDS_HD_ADI:
|
|
|
|
|
! ------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine determines the maximum characteristic speed and eigenvalue
|
|
|
|
|
! in the input array of primitive variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the input array of primitive variables;
|
|
|
|
|
! vm - the maximum physical speed;
|
2022-01-07 15:38:54 -03:00
|
|
|
|
! cm - the maximum eigenvalue;
|
2022-01-06 22:44:21 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_hd_adi(qq, vm, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
use coordinates, only : nb, ne
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out) :: vm, cm
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2022-01-06 22:44:21 -03:00
|
|
|
|
real(kind=8) :: vl, vu, cc
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vm = 0.0d+00
|
|
|
|
|
cm = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2022-01-06 22:44:21 -03:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
|
|
|
|
vl = minval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vu = maxval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vm = max(vm, abs(vl), abs(vu))
|
|
|
|
|
|
|
|
|
|
cc = sqrt(adiabatic_index * qq(ipr,i,j,k) / qq(idn,i,j,k))
|
2022-01-07 15:38:54 -03:00
|
|
|
|
cm = max(cm, abs(vl - cc), abs(vu + cc))
|
2022-01-06 22:44:21 -03:00
|
|
|
|
end do
|
|
|
|
|
end do
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine get_maximum_speeds_hd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2014-03-06 13:16:57 -03:00
|
|
|
|
! subroutine ESYSTEM_ROE_HD_ADI:
|
|
|
|
|
! -----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine computes eigenvalues and eigenvectors for a given set of
|
|
|
|
|
! equations and input variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2014-03-06 13:55:09 -03:00
|
|
|
|
! x - ratio of the perpendicular magnetic field component difference
|
|
|
|
|
! y - ratio of the density
|
2014-03-06 13:16:57 -03:00
|
|
|
|
! q - the intermediate Roe state vector;
|
|
|
|
|
! c - the vector of eigenvalues;
|
|
|
|
|
! r - the matrix of right eigenvectors;
|
|
|
|
|
! l - the matrix of left eigenvectors;
|
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! [1] Roe, P. L.
|
|
|
|
|
! "Approximate Riemann Solvers, Parameter Vectors, and Difference
|
|
|
|
|
! Schemes",
|
|
|
|
|
! Journal of Computational Physics, 1981, 43, pp. 357-372
|
|
|
|
|
! [2] Stone, J. M. & Gardiner, T. A.,
|
|
|
|
|
! "ATHENA: A New Code for Astrophysical MHD",
|
|
|
|
|
! The Astrophysical Journal Suplement Series, 2008, 178, pp. 137-177
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2014-03-06 13:55:09 -03:00
|
|
|
|
subroutine esystem_roe_hd_adi(x, y, q, c, r, l)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 18:10:07 -02:00
|
|
|
|
real(kind=8) , intent(in) :: x, y
|
|
|
|
|
real(kind=8), dimension(:) , intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:) , intent(inout) :: c
|
|
|
|
|
real(kind=8), dimension(:,:), intent(inout) :: l, r
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
logical , save :: first = .true.
|
|
|
|
|
real(kind=8), dimension(5,5), save :: lvec, rvec
|
|
|
|
|
!$omp threadprivate(first, lvec, rvec)
|
|
|
|
|
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) :: vv, vh, c2, cc, vc, fc, fh, f1, f2, fv, fx
|
2021-12-15 12:44:10 -03:00
|
|
|
|
|
2014-03-06 13:16:57 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
if (first) then
|
2021-12-15 14:06:44 -03:00
|
|
|
|
lvec(:,:) = 0.0d+00
|
|
|
|
|
rvec(:,:) = 0.0d+00
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
lvec(ivy,2) = 1.0d+00
|
|
|
|
|
lvec(ivz,3) = 1.0d+00
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
rvec(1,idn) = 1.0d+00
|
|
|
|
|
rvec(2,ivy) = 1.0d+00
|
|
|
|
|
rvec(3,ivz) = 1.0d+00
|
|
|
|
|
rvec(4,idn) = 1.0d+00
|
|
|
|
|
rvec(5,idn) = 1.0d+00
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
|
|
|
|
first = .false.
|
2021-12-15 12:44:10 -03:00
|
|
|
|
end if
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
|
|
|
|
! calculate characteristic speeds and useful variables
|
|
|
|
|
!
|
|
|
|
|
vv = sum(q(ivx:ivz)**2)
|
2021-12-15 14:06:44 -03:00
|
|
|
|
vh = 5.0d-01 * vv
|
2014-03-06 13:16:57 -03:00
|
|
|
|
c2 = gammam1 * (q(ien) - vh)
|
|
|
|
|
cc = sqrt(c2)
|
|
|
|
|
vc = q(ivx) * cc
|
2021-12-15 14:06:44 -03:00
|
|
|
|
fc = gammam1 / c2
|
|
|
|
|
fh = 5.0d-01 * fc
|
|
|
|
|
f1 = 5.0d-01 * vc / c2
|
|
|
|
|
f2 = 5.0d-01 * cc / c2
|
|
|
|
|
fv = fh * vh
|
|
|
|
|
fx = fh * q(ivx)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 14:06:44 -03:00
|
|
|
|
! eigenvalues
|
2014-03-06 13:16:57 -03:00
|
|
|
|
!
|
2021-12-15 14:06:44 -03:00
|
|
|
|
c(1) = q(ivx) - cc
|
|
|
|
|
c(2) = q(ivx)
|
|
|
|
|
c(3) = q(ivx)
|
|
|
|
|
c(4) = q(ivx)
|
|
|
|
|
c(5) = q(ivx) + cc
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 14:06:44 -03:00
|
|
|
|
! update the varying elements of the left eigenvectors matrix
|
2014-03-06 13:16:57 -03:00
|
|
|
|
!
|
2021-12-15 14:06:44 -03:00
|
|
|
|
lvec(idn,1) = fv + f1
|
|
|
|
|
lvec(ivx,1) = - fx - f2
|
|
|
|
|
lvec(ivy,1) = - fh * q(ivy)
|
|
|
|
|
lvec(ivz,1) = - fh * q(ivz)
|
|
|
|
|
lvec(ien,1) = fh
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
lvec(idn,2) = - q(ivy)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
lvec(idn,3) = - q(ivz)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 14:06:44 -03:00
|
|
|
|
lvec(idn,4) = 1.0d+00 - fh * vv
|
|
|
|
|
lvec(ivx,4) = fc * q(ivx)
|
|
|
|
|
lvec(ivy,4) = fc * q(ivy)
|
|
|
|
|
lvec(ivz,4) = fc * q(ivz)
|
|
|
|
|
lvec(ien,4) = - fc
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 14:06:44 -03:00
|
|
|
|
lvec(idn,5) = fv - f1
|
|
|
|
|
lvec(ivx,5) = - fx + f2
|
|
|
|
|
lvec(ivy,5) = lvec(ivy,1)
|
|
|
|
|
lvec(ivz,5) = lvec(ivz,1)
|
|
|
|
|
lvec(ien,5) = fh
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 14:06:44 -03:00
|
|
|
|
! update the varying elements of the right eigenvectors matrix
|
2014-03-06 13:16:57 -03:00
|
|
|
|
!
|
2021-12-15 12:44:10 -03:00
|
|
|
|
rvec(1,ivx) = q(ivx) - cc
|
|
|
|
|
rvec(1,ivy) = q(ivy)
|
|
|
|
|
rvec(1,ivz) = q(ivz)
|
|
|
|
|
rvec(1,ien) = q(ien) - vc
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
rvec(2,ien) = q(ivy)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
rvec(3,ien) = q(ivz)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
rvec(4,ivx) = q(ivx)
|
|
|
|
|
rvec(4,ivy) = q(ivy)
|
|
|
|
|
rvec(4,ivz) = q(ivz)
|
|
|
|
|
rvec(4,ien) = vh
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
2021-12-15 12:44:10 -03:00
|
|
|
|
rvec(5,ivx) = q(ivx) + cc
|
|
|
|
|
rvec(5,ivy) = q(ivy)
|
|
|
|
|
rvec(5,ivz) = q(ivz)
|
|
|
|
|
rvec(5,ien) = q(ien) + vc
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
|
|
|
|
! copy matrices of eigenvectors
|
|
|
|
|
!
|
2021-12-15 12:44:10 -03:00
|
|
|
|
l(:,:) = lvec(:,:)
|
|
|
|
|
r(:,:) = rvec(:,:)
|
2014-03-06 13:16:57 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine esystem_roe_hd_adi
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!*******************************************************************************
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! ISOTHERMAL MAGNETOHYDRODYNAMIC EQUATIONS
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!*******************************************************************************
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine PRIM2CONS_MHD_ISO:
|
|
|
|
|
! ----------------------------
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine converts primitive variables to their corresponding
|
|
|
|
|
! conservative representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the output array of conservative variables;
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! s - an optional flag indicating that passive scalars have
|
|
|
|
|
! to be calculated too;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_mhd_iso(q, u, s)
|
2012-07-27 22:28:29 -03:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2012-07-27 22:28:29 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! local variables
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
integer :: i, p
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
|
|
|
|
! iterate over all positions
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2012-07-27 22:28:29 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
u(idn,i) = q(idn,i)
|
|
|
|
|
u(imx,i) = q(idn,i) * q(ivx,i)
|
|
|
|
|
u(imy,i) = q(idn,i) * q(ivy,i)
|
|
|
|
|
u(imz,i) = q(idn,i) * q(ivz,i)
|
|
|
|
|
u(ibx,i) = q(ibx,i)
|
|
|
|
|
u(iby,i) = q(iby,i)
|
|
|
|
|
u(ibz,i) = q(ibz,i)
|
|
|
|
|
u(ibp,i) = q(ibp,i)
|
2012-07-27 22:28:29 -03:00
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
end do
|
2012-07-27 22:28:29 -03:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! update primitive passive scalars
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0 .and. present(s)) then
|
|
|
|
|
if (s) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
u(p,:) = q(p,:) * u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2012-07-27 22:28:29 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine prim2cons_mhd_iso
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine CONS2PRIM_MHD_ISO:
|
|
|
|
|
! ----------------------------
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine converts conservative variables to their corresponding
|
|
|
|
|
! primitive representation.
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! q - the output array of primitive variables;
|
2021-11-09 13:21:32 -03:00
|
|
|
|
! s - the status flag;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_mhd_iso(u, q, s)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 0
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
do i = 1, size(u,2)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
if (u(idn,i) > 0.0d+00) then
|
|
|
|
|
q(idn,i) = u(idn,i)
|
|
|
|
|
q(ivx,i) = u(imx,i) / u(idn,i)
|
|
|
|
|
q(ivy,i) = u(imy,i) / u(idn,i)
|
|
|
|
|
q(ivz,i) = u(imz,i) / u(idn,i)
|
|
|
|
|
q(ibx,i) = u(ibx,i)
|
|
|
|
|
q(iby,i) = u(iby,i)
|
|
|
|
|
q(ibz,i) = u(ibz,i)
|
|
|
|
|
q(ibp,i) = u(ibp,i)
|
|
|
|
|
else
|
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
|
|
|
|
end if
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
end do
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
q(p,:) = u(p,:) / u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine cons2prim_mhd_iso
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine FLUXSPEED_MHD_ISO:
|
|
|
|
|
! ----------------------------
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine calculates physical fluxes and characteristic speeds from a
|
|
|
|
|
! given equation system.
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! f - the output vector of fluxes;
|
|
|
|
|
! c - the output vector of left- and right-going characteristic speeds;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_mhd_iso(q, u, f, c)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
integer :: i
|
2015-12-10 07:07:10 -02:00
|
|
|
|
real(kind=8) :: by2, bz2, pt
|
2015-02-05 22:07:19 -02:00
|
|
|
|
real(kind=8) :: fa, fb, fc, cf
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
! local arrays
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(size(q,2)) :: bx2, bb
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2015-12-10 07:07:10 -02:00
|
|
|
|
! calculate the magnetohydrodynamic fluxes
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2015-12-10 07:07:10 -02:00
|
|
|
|
bx2(i) = q(ibx,i) * q(ibx,i)
|
|
|
|
|
by2 = q(iby,i) * q(iby,i)
|
|
|
|
|
bz2 = q(ibz,i) * q(ibz,i)
|
|
|
|
|
bb(i) = bx2(i) + by2 + bz2
|
|
|
|
|
pt = csnd2 * q(idn,i) + 0.5d+00 * bb(i)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
f(idn,i) = u(imx,i)
|
2015-12-10 07:07:10 -02:00
|
|
|
|
f(imx,i) = q(ivx,i) * u(imx,i) - bx2(i)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
f(imy,i) = q(ivx,i) * u(imy,i) - q(ibx,i) * q(iby,i)
|
|
|
|
|
f(imz,i) = q(ivx,i) * u(imz,i) - q(ibx,i) * q(ibz,i)
|
|
|
|
|
f(imx,i) = f(imx,i) + pt
|
|
|
|
|
f(ibx,i) = q(ibp,i)
|
|
|
|
|
f(iby,i) = q(ivx,i) * q(iby,i) - q(ibx,i) * q(ivy,i)
|
|
|
|
|
f(ibz,i) = q(ivx,i) * q(ibz,i) - q(ibx,i) * q(ivz,i)
|
|
|
|
|
f(ibp,i) = cmax2 * q(ibx,i)
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2015-12-10 07:07:10 -02:00
|
|
|
|
! calculate the characteristic speeds
|
2015-02-05 22:07:19 -02:00
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (present(c)) then
|
2015-02-05 22:07:19 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-08-04 11:16:40 -03:00
|
|
|
|
fa = csnd2 * q(idn,i)
|
|
|
|
|
fb = fa + bb(i)
|
|
|
|
|
fc = max(0.0d+00, fb * fb - 4.0d+00 * fa * bx2(i))
|
|
|
|
|
cf = sqrt(max(0.5d+00 * (fb + sqrt(fc)), bb(i)) / q(idn,i))
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = q(ivx,i) - cf
|
|
|
|
|
c(2,i) = q(ivx,i) + cf
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
end if
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine fluxspeed_mhd_iso
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! function MAXSPEED_MHD_ISO:
|
|
|
|
|
! -------------------------
|
|
|
|
|
!
|
|
|
|
|
! Function scans the variable array and returns the maximum speed in within.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the array of primitive variables;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
function maxspeed_mhd_iso(qq) result(maxspeed)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
use coordinates, only : nb, ne
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
real(kind=8) :: maxspeed
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2013-12-10 20:56:37 -02:00
|
|
|
|
real(kind=8) :: vv, bb, v, c
|
2022-01-08 10:45:02 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
maxspeed = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
! calculate the velocity amplitude
|
|
|
|
|
!
|
|
|
|
|
vv = sum(qq(ivx:ivz,i,j,k) * qq(ivx:ivz,i,j,k))
|
|
|
|
|
v = sqrt(vv)
|
|
|
|
|
bb = sum(qq(ibx:ibz,i,j,k) * qq(ibx:ibz,i,j,k))
|
|
|
|
|
|
|
|
|
|
! calculate the fast magnetosonic speed
|
|
|
|
|
!
|
|
|
|
|
c = sqrt(csnd2 + bb / qq(idn,i,j,k))
|
|
|
|
|
|
|
|
|
|
! calculate the maximum of speed
|
|
|
|
|
!
|
|
|
|
|
maxspeed = max(maxspeed, v + c)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! i = nb, ne
|
|
|
|
|
end do ! j = nb, ne
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do ! k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end function maxspeed_mhd_iso
|
|
|
|
|
!
|
2014-03-06 13:55:09 -03:00
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! subroutine GET_MAXIMUM_SPEEDS_MHD_ISO:
|
|
|
|
|
! -------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine determines the maximum characteristic speed and eigenvalue
|
|
|
|
|
! in the input array of primitive variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the input array of primitive variables;
|
|
|
|
|
! vm - the maximum physical speed;
|
2022-01-07 15:38:54 -03:00
|
|
|
|
! cm - the maximum eigenvalue;
|
2022-01-06 22:44:21 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_mhd_iso(qq, vm, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
use coordinates, only : nb, ne
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out) :: vm, cm
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2022-01-06 22:44:21 -03:00
|
|
|
|
real(kind=8) :: vl, vu, cc, xx
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(3) :: bb
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vm = 0.0d+00
|
|
|
|
|
cm = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2022-01-06 22:44:21 -03:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
|
|
|
|
vl = minval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vu = maxval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vm = max(vm, abs(vl), abs(vu))
|
|
|
|
|
|
|
|
|
|
bb = qq(ibx:ibz,i,j,k) * qq(ibx:ibz,i,j,k) / qq(idn,i,j,k)
|
|
|
|
|
xx = csnd2 + bb(1) + bb(2) + bb(3)
|
|
|
|
|
cc = max(0.0d+00, xx**2 - 4.0d+00 * csnd2 * bb(1))
|
|
|
|
|
cc = sqrt(5.0d-01 * (xx + sqrt(cc)))
|
2022-01-07 15:38:54 -03:00
|
|
|
|
cm = max(cm, abs(vl - cc), abs(vu + cc))
|
2022-01-06 22:44:21 -03:00
|
|
|
|
end do
|
|
|
|
|
end do
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine get_maximum_speeds_mhd_iso
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2014-03-06 13:55:09 -03:00
|
|
|
|
! subroutine ESYSTEM_ROE_MHD_ISO:
|
|
|
|
|
! ------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine computes eigenvalues and eigenvectors for a given set of
|
|
|
|
|
! equations and input variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! x - ratio of the perpendicular magnetic field component difference
|
|
|
|
|
! y - ratio of the density
|
|
|
|
|
! q - the intermediate Roe state vector;
|
|
|
|
|
! c - the vector of eigenvalues;
|
|
|
|
|
! r - the matrix of right eigenvectors;
|
|
|
|
|
! l - the matrix of left eigenvectors;
|
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! [1] Stone, J. M. & Gardiner, T. A.,
|
|
|
|
|
! "ATHENA: A New Code for Astrophysical MHD",
|
|
|
|
|
! The Astrophysical Journal Suplement Series, 2008, 178, pp. 137-177
|
|
|
|
|
! [2] Balsara, D. S.
|
|
|
|
|
! "Linearized Formulation of the Riemann Problem for Adiabatic and
|
|
|
|
|
! Isothermal Magnetohydrodynamics",
|
|
|
|
|
! The Astrophysical Journal Suplement Series, 1998, 116, pp. 119-131
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine esystem_roe_mhd_iso(x, y, q, c, r, l)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 18:10:07 -02:00
|
|
|
|
real(kind=8) , intent(in) :: x, y
|
|
|
|
|
real(kind=8), dimension(:) , intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:) , intent(inout) :: c
|
|
|
|
|
real(kind=8), dimension(:,:), intent(inout) :: l, r
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 12:40:40 -03:00
|
|
|
|
logical , save :: first = .true.
|
2021-12-15 12:44:10 -03:00
|
|
|
|
real(kind=8), dimension(8,8), save :: lvec, rvec
|
2021-12-15 12:40:40 -03:00
|
|
|
|
!$omp threadprivate(first, lvec, rvec)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 16:22:37 -03:00
|
|
|
|
real(kind=8) :: ca, ca2, ct2, cf, cf2, cs, cs2, cf2_cs2
|
|
|
|
|
real(kind=8) :: br, br2, brs, br2s, tsum, tdif, twid_c2, twid_c
|
|
|
|
|
real(kind=8) :: bty, btz, btys, btzs, bt2s, alf, als, norm
|
|
|
|
|
real(kind=8) :: sqrtd, sgn, qf, qs, af_prime, as_prime
|
|
|
|
|
real(kind=8) :: cff, css, af, as, afpb, aspb, q2s, q3s, vqstr
|
2021-12-15 12:40:40 -03:00
|
|
|
|
|
2014-03-06 13:55:09 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
if (first) then
|
2021-12-15 16:22:37 -03:00
|
|
|
|
lvec(:,:) = 0.0d+00
|
|
|
|
|
rvec(:,:) = 0.0d+00
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
first = .false.
|
2021-12-15 12:40:40 -03:00
|
|
|
|
end if
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 16:22:37 -03:00
|
|
|
|
! coefficients for eigenvalues
|
|
|
|
|
!
|
|
|
|
|
ca2 = q(ibx) * q(ibx) / q(idn)
|
|
|
|
|
ca = sqrt(ca2)
|
|
|
|
|
br2 = sum(q(iby:ibz)**2)
|
|
|
|
|
br2s = br2 * y
|
|
|
|
|
ct2 = br2s / q(idn)
|
|
|
|
|
|
|
|
|
|
twid_c2 = csnd2 + x
|
|
|
|
|
tsum = ca2 + ct2 + twid_c2
|
|
|
|
|
tdif = ca2 + ct2 - twid_c2
|
|
|
|
|
cf2_cs2 = sqrt(tdif * tdif + 4.0d+00 * twid_c2 * ct2)
|
|
|
|
|
cf2 = 0.5d+00 * (tsum + cf2_cs2)
|
|
|
|
|
cf = sqrt(cf2)
|
|
|
|
|
cs2 = twid_c2 * ca2 / cf2
|
|
|
|
|
cs = sqrt(cs2)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 12:40:40 -03:00
|
|
|
|
! eigenvalues
|
2014-03-06 13:55:09 -03:00
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
c(1) = q(ivx) - cf
|
|
|
|
|
c(2) = q(ivx) - ca
|
|
|
|
|
c(3) = q(ivx) - cs
|
|
|
|
|
c(4) = q(ivx)
|
|
|
|
|
c(5) = q(ivx) + cs
|
|
|
|
|
c(6) = q(ivx) + ca
|
|
|
|
|
c(7) = q(ivx) + cf
|
|
|
|
|
c(8) = c(7)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! calculate the eigenvectors only if the waves propagate in both direction
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
if (c(1) >= 0.0d+00 .or. c(7) <= 0.0d+00) return
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 12:40:40 -03:00
|
|
|
|
! remaining coefficients
|
2014-03-06 13:55:09 -03:00
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
br = sqrt(br2)
|
|
|
|
|
brs = sqrt(br2s)
|
|
|
|
|
if (abs(br) > 0.0d+00) then
|
|
|
|
|
bty = q(iby) / br
|
|
|
|
|
btz = q(ibz) / br
|
2020-08-06 18:31:14 -03:00
|
|
|
|
else
|
2021-12-15 16:22:37 -03:00
|
|
|
|
bty = 1.0d+00
|
|
|
|
|
btz = 0.0d+00
|
2014-03-06 13:55:09 -03:00
|
|
|
|
end if
|
2021-12-15 16:22:37 -03:00
|
|
|
|
btys = bty / sqrt(y)
|
|
|
|
|
btzs = btz / sqrt(y)
|
|
|
|
|
bt2s = btys * btys + btzs * btzs
|
|
|
|
|
|
|
|
|
|
if (.not. abs(cf2 - cs2) > 0.0d+00) then
|
|
|
|
|
alf = 1.0d+00
|
|
|
|
|
als = 0.0d+00
|
|
|
|
|
else if ((twid_c2 - cs2) <= 0.0d+00) then
|
|
|
|
|
alf = 0.0d+00
|
|
|
|
|
als = 1.0d+00
|
|
|
|
|
else if ((cf2 - twid_c2) <= 0.0d+00) then
|
|
|
|
|
alf = 1.0d+00
|
|
|
|
|
als = 0.0d+00
|
2014-03-06 13:55:09 -03:00
|
|
|
|
else
|
2021-12-15 16:22:37 -03:00
|
|
|
|
alf = sqrt((twid_c2 - cs2) / (cf2 - cs2))
|
|
|
|
|
als = sqrt((cf2 - twid_c2) / (cf2 - cs2))
|
2014-03-06 13:55:09 -03:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
sqrtd = sqrt(q(idn))
|
2021-12-15 16:22:37 -03:00
|
|
|
|
sgn = sign(1.0d+00, q(ibx))
|
|
|
|
|
twid_c = sqrt(twid_c2)
|
|
|
|
|
qf = cf * alf * sgn
|
|
|
|
|
qs = cs * als * sgn
|
|
|
|
|
af_prime = twid_c * alf / sqrtd
|
|
|
|
|
as_prime = twid_c * als / sqrtd
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 16:22:37 -03:00
|
|
|
|
! === update the varying elements of the right eigenvectors matrix
|
2014-03-06 13:55:09 -03:00
|
|
|
|
!
|
|
|
|
|
! left-going fast wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
rvec(1,idn) = alf
|
|
|
|
|
rvec(1,ivx) = alf * c(1)
|
|
|
|
|
rvec(1,ivy) = alf * q(ivy) + qs * btys
|
|
|
|
|
rvec(1,ivz) = alf * q(ivz) + qs * btzs
|
|
|
|
|
rvec(1,iby) = as_prime * btys
|
|
|
|
|
rvec(1,ibz) = as_prime * btzs
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! left-going Alfvèn wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
rvec(2,ivy) = - btz
|
|
|
|
|
rvec(2,ivz) = bty
|
|
|
|
|
rvec(2,iby) = - btz * sgn / sqrtd
|
|
|
|
|
rvec(2,ibz) = bty * sgn / sqrtd
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! left-going slow wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
rvec(3,idn) = als
|
|
|
|
|
rvec(3,ivx) = als * c(3)
|
|
|
|
|
rvec(3,ivy) = als * q(ivy) - qf * btys
|
|
|
|
|
rvec(3,ivz) = als * q(ivz) - qf * btzs
|
|
|
|
|
rvec(3,iby) = - af_prime * btys
|
|
|
|
|
rvec(3,ibz) = - af_prime * btzs
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! right-going slow wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
rvec(5,idn) = als
|
|
|
|
|
rvec(5,ivx) = als * c(5)
|
|
|
|
|
rvec(5,ivy) = als * q(ivy) + qf * btys
|
|
|
|
|
rvec(5,ivz) = als * q(ivz) + qf * btzs
|
2021-12-15 12:40:40 -03:00
|
|
|
|
rvec(5,iby) = rvec(3,iby)
|
|
|
|
|
rvec(5,ibz) = rvec(3,ibz)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! right-going Alfvèn wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
rvec(6,ivy) = btz
|
|
|
|
|
rvec(6,ivz) = - bty
|
2021-12-15 12:40:40 -03:00
|
|
|
|
rvec(6,iby) = rvec(2,iby)
|
|
|
|
|
rvec(6,ibz) = rvec(2,ibz)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! right-going fast wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
rvec(7,idn) = alf
|
|
|
|
|
rvec(7,ivx) = alf * c(7)
|
|
|
|
|
rvec(7,ivy) = alf * q(ivy) - qs * btys
|
|
|
|
|
rvec(7,ivz) = alf * q(ivz) - qs * btzs
|
2021-12-15 12:40:40 -03:00
|
|
|
|
rvec(7,iby) = rvec(1,iby)
|
|
|
|
|
rvec(7,ibz) = rvec(1,ibz)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 16:22:37 -03:00
|
|
|
|
! === update the varying elements of the left eigenvectors matrix
|
2014-03-06 13:55:09 -03:00
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
norm = 2.0d+00 * twid_c2
|
|
|
|
|
cff = alf * cf / norm
|
|
|
|
|
css = als * cs / norm
|
|
|
|
|
qf = qf / norm
|
|
|
|
|
qs = qs / norm
|
|
|
|
|
af = af_prime * q(idn) / norm
|
|
|
|
|
as = as_prime * q(idn) / norm
|
|
|
|
|
afpb = af_prime * brs / norm
|
|
|
|
|
aspb = as_prime * brs / norm
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
2021-12-15 16:22:37 -03:00
|
|
|
|
q2s = btys / bt2s
|
|
|
|
|
q3s = btzs / bt2s
|
|
|
|
|
vqstr = q(ivy) * q2s + q(ivz) * q3s
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! left-going fast wave
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
lvec(idn,1) = cff * c(7) - qs * vqstr - aspb
|
|
|
|
|
lvec(ivx,1) = - cff
|
2021-12-15 16:22:37 -03:00
|
|
|
|
lvec(ivy,1) = qs * q2s
|
|
|
|
|
lvec(ivz,1) = qs * q3s
|
|
|
|
|
lvec(iby,1) = as * q2s
|
|
|
|
|
lvec(ibz,1) = as * q3s
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! left-going Alfvèn wave
|
|
|
|
|
!
|
2021-12-15 16:22:37 -03:00
|
|
|
|
lvec(idn,2) = 0.5d+00 * (q(ivy) * btz - q(ivz) * bty)
|
|
|
|
|
lvec(ivy,2) = - 0.5d+00 * btz
|
|
|
|
|
lvec(ivz,2) = 0.5d+00 * bty
|
|
|
|
|
lvec(iby,2) = - 0.5d+00 * sqrtd * btz * sgn
|
|
|
|
|
lvec(ibz,2) = 0.5d+00 * sqrtd * bty * sgn
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! left-going slow wave
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
lvec(idn,3) = css * c(5) + qf * vqstr + afpb
|
|
|
|
|
lvec(ivx,3) = - css
|
2021-12-15 16:22:37 -03:00
|
|
|
|
lvec(ivy,3) = - qf * q2s
|
|
|
|
|
lvec(ivz,3) = - qf * q3s
|
|
|
|
|
lvec(iby,3) = - af * q2s
|
|
|
|
|
lvec(ibz,3) = - af * q3s
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! right-going slow wave
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
lvec(idn,5) = - css * c(3) - qf * vqstr + afpb
|
|
|
|
|
lvec(ivx,5) = css
|
|
|
|
|
lvec(ivy,5) = - lvec(ivy,3)
|
|
|
|
|
lvec(ivz,5) = - lvec(ivz,3)
|
|
|
|
|
lvec(iby,5) = lvec(iby,3)
|
|
|
|
|
lvec(ibz,5) = lvec(ibz,3)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! right-going Alfvèn wave
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
lvec(idn,6) = - lvec(idn,2)
|
|
|
|
|
lvec(ivy,6) = - lvec(ivy,2)
|
|
|
|
|
lvec(ivz,6) = - lvec(ivz,2)
|
|
|
|
|
lvec(iby,6) = lvec(iby,2)
|
|
|
|
|
lvec(ibz,6) = lvec(ibz,2)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! right-going fast wave
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
lvec(idn,7) = - cff * c(1) + qs * vqstr - aspb
|
|
|
|
|
lvec(ivx,7) = cff
|
|
|
|
|
lvec(ivy,7) = - lvec(ivy,1)
|
|
|
|
|
lvec(ivz,7) = - lvec(ivz,1)
|
|
|
|
|
lvec(iby,7) = lvec(iby,1)
|
|
|
|
|
lvec(ibz,7) = lvec(ibz,1)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
! copy matrices of eigenvectors
|
|
|
|
|
!
|
2021-12-15 12:40:40 -03:00
|
|
|
|
l(:,:) = lvec(:,:)
|
|
|
|
|
r(:,:) = rvec(:,:)
|
2014-03-06 13:55:09 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine esystem_roe_mhd_iso
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
! ADIABATIC MAGNETOHYDRODYNAMIC EQUATIONS
|
|
|
|
|
!
|
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine PRIM2CONS_MHD_ADI:
|
|
|
|
|
! ----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts primitive variables to their corresponding
|
|
|
|
|
! conservative representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the output array of conservative variables;
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! s - an optional flag indicating that passive scalars have
|
|
|
|
|
! to be calculated too;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_mhd_adi(q, u, s)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
integer :: i, p
|
2022-01-06 16:32:58 -03:00
|
|
|
|
real(kind=8) :: ei, ek, em, ep
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
u(idn,i) = q(idn,i)
|
|
|
|
|
u(imx,i) = q(idn,i) * q(ivx,i)
|
|
|
|
|
u(imy,i) = q(idn,i) * q(ivy,i)
|
|
|
|
|
u(imz,i) = q(idn,i) * q(ivz,i)
|
|
|
|
|
u(ibx,i) = q(ibx,i)
|
|
|
|
|
u(iby,i) = q(iby,i)
|
|
|
|
|
u(ibz,i) = q(ibz,i)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
u(ibp,i) = q(ibp,i)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
ei = gammam1i * q(ipr,i)
|
2022-01-06 16:32:58 -03:00
|
|
|
|
ek = sum(u(imx:imz,i) * q(ivx:ivz,i))
|
|
|
|
|
em = sum(q(ibx:ibz,i) * q(ibx:ibz,i))
|
|
|
|
|
ep = q(ibp,i) * q(ibp,i)
|
|
|
|
|
u(ien,i) = ei + 5.0d-01 * (ek + em + ep)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
end do
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
if (ns > 0 .and. present(s)) then
|
|
|
|
|
if (s) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
u(p,:) = q(p,:) * u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine prim2cons_mhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine CONS2PRIM_MHD_ADI:
|
|
|
|
|
! ----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts conservative variables to their corresponding
|
|
|
|
|
! primitive representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! q - the output array of primitive variables;
|
2021-11-09 13:21:32 -03:00
|
|
|
|
! s - the status flag;
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_mhd_adi(u, q, s)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2022-01-06 16:32:58 -03:00
|
|
|
|
real(kind=8) :: ei, ek, em, ep
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 0
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
do i = 1, size(u,2)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
if (u(idn,i) > 0.0d+00) then
|
|
|
|
|
q(idn,i) = u(idn,i)
|
|
|
|
|
q(ivx,i) = u(imx,i) / u(idn,i)
|
|
|
|
|
q(ivy,i) = u(imy,i) / u(idn,i)
|
|
|
|
|
q(ivz,i) = u(imz,i) / u(idn,i)
|
|
|
|
|
q(ibx,i) = u(ibx,i)
|
|
|
|
|
q(iby,i) = u(iby,i)
|
|
|
|
|
q(ibz,i) = u(ibz,i)
|
|
|
|
|
q(ibp,i) = u(ibp,i)
|
2022-01-06 16:32:58 -03:00
|
|
|
|
ek = sum(u(imx:imz,i) * q(ivx:ivz,i))
|
|
|
|
|
em = sum(q(ibx:ibz,i) * q(ibx:ibz,i))
|
|
|
|
|
ep = q(ibp,i) * q(ibp,i)
|
|
|
|
|
ei = u(ien,i) - 5.0d-01 * (ek + em + ep)
|
2021-11-09 13:21:32 -03:00
|
|
|
|
if (ei > 0.0d+00) then
|
|
|
|
|
q(ipr,i) = gammam1 * ei
|
|
|
|
|
else
|
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
|
|
|
|
end if
|
|
|
|
|
else
|
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
|
|
|
|
end if
|
2013-12-10 20:56:37 -02:00
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
end do
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
q(p,:) = u(p,:) / u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine cons2prim_mhd_adi
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! subroutine FLUXSPEED_MHD_ADI:
|
|
|
|
|
! ----------------------------
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Subroutine calculates physical fluxes and characteristic speeds from a
|
|
|
|
|
! given equation system.
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! f - the output vector of fluxes;
|
|
|
|
|
! c - the output vector of left- and right-going characteristic speeds;
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_mhd_adi(q, u, f, c)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
integer :: i
|
2015-12-10 07:07:10 -02:00
|
|
|
|
real(kind=8) :: by2, bz2, pt
|
2013-12-10 20:56:37 -02:00
|
|
|
|
real(kind=8) :: vb
|
2015-02-05 22:07:19 -02:00
|
|
|
|
real(kind=8) :: fa, fb, fc, cf
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
! local arrays
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(size(q,2)) :: bx2, bb
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2014-01-02 12:06:35 -02:00
|
|
|
|
!
|
2015-12-10 07:07:10 -02:00
|
|
|
|
! calculate the magnetohydrodynamic fluxes
|
2012-07-27 16:18:02 -03:00
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2015-12-10 07:07:10 -02:00
|
|
|
|
bx2(i) = q(ibx,i) * q(ibx,i)
|
|
|
|
|
by2 = q(iby,i) * q(iby,i)
|
|
|
|
|
bz2 = q(ibz,i) * q(ibz,i)
|
|
|
|
|
bb(i) = bx2(i) + by2 + bz2
|
2013-12-10 20:56:37 -02:00
|
|
|
|
vb = sum(q(ivx:ivz,i) * q(ibx:ibz,i))
|
2015-12-10 07:07:10 -02:00
|
|
|
|
pt = q(ipr,i) + 0.5d+00 * bb(i)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
f(idn,i) = u(imx,i)
|
2015-12-10 07:07:10 -02:00
|
|
|
|
f(imx,i) = q(ivx,i) * u(imx,i) - bx2(i)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
f(imy,i) = q(ivx,i) * u(imy,i) - q(ibx,i) * q(iby,i)
|
|
|
|
|
f(imz,i) = q(ivx,i) * u(imz,i) - q(ibx,i) * q(ibz,i)
|
|
|
|
|
f(imx,i) = f(imx,i) + pt
|
2013-12-10 20:56:37 -02:00
|
|
|
|
f(ibx,i) = q(ibp,i)
|
2012-07-27 16:18:02 -03:00
|
|
|
|
f(iby,i) = q(ivx,i) * q(iby,i) - q(ibx,i) * q(ivy,i)
|
|
|
|
|
f(ibz,i) = q(ivx,i) * q(ibz,i) - q(ibx,i) * q(ivz,i)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
f(ibp,i) = cmax2 * q(ibx,i)
|
|
|
|
|
f(ien,i) = q(ivx,i) * (u(ien,i) + pt) - q(ibx,i) * vb
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
2015-12-10 07:07:10 -02:00
|
|
|
|
! calculate the characteristic speeds
|
2015-02-05 22:07:19 -02:00
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (present(c)) then
|
2015-02-05 22:07:19 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-08-16 16:41:28 -03:00
|
|
|
|
fa = adiabatic_index * q(ipr,i)
|
2020-08-04 11:16:40 -03:00
|
|
|
|
fb = fa + bb(i)
|
|
|
|
|
fc = max(0.0d+00, fb * fb - 4.0d+00 * fa * bx2(i))
|
|
|
|
|
cf = sqrt(max(0.5d+00 * (fb + sqrt(fc)), bb(i)) / q(idn,i))
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = q(ivx,i) - cf
|
|
|
|
|
c(2,i) = q(ivx,i) + cf
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:07:10 -02:00
|
|
|
|
|
|
|
|
|
end if
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end subroutine fluxspeed_mhd_adi
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! function MAXSPEED_MHD_ADI:
|
|
|
|
|
! -------------------------
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
! Function scans the variable array and returns the maximum speed in within.
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the array of primitive variables;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
function maxspeed_mhd_adi(qq) result(maxspeed)
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
use coordinates, only : nb, ne
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2013-12-10 20:56:37 -02:00
|
|
|
|
real(kind=8) :: maxspeed
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2013-12-10 20:56:37 -02:00
|
|
|
|
real(kind=8) :: vv, bb, v, c
|
2022-01-08 10:45:02 -03:00
|
|
|
|
|
2012-08-01 12:16:38 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
maxspeed = 0.0d+00
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
! calculate the velocity amplitude
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
vv = sum(qq(ivx:ivz,i,j,k) * qq(ivx:ivz,i,j,k))
|
2012-08-01 12:16:38 -03:00
|
|
|
|
v = sqrt(vv)
|
2013-12-10 20:56:37 -02:00
|
|
|
|
bb = sum(qq(ibx:ibz,i,j,k) * qq(ibx:ibz,i,j,k))
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
! calculate the fast magnetosonic speed
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c = sqrt((adiabatic_index * qq(ipr,i,j,k) + bb) / qq(idn,i,j,k))
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
! calculate the maximum of speed
|
|
|
|
|
!
|
|
|
|
|
maxspeed = max(maxspeed, v + c)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! i = nb, ne
|
|
|
|
|
end do ! j = nb, ne
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do ! k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2012-08-01 12:16:38 -03:00
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2013-12-10 20:56:37 -02:00
|
|
|
|
end function maxspeed_mhd_adi
|
2014-03-06 14:19:31 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! subroutine GET_MAXIMUM_SPEEDS_MHD_ADI:
|
|
|
|
|
! -------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine determines the maximum characteristic speed and eigenvalue
|
|
|
|
|
! in the input array of primitive variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the input array of primitive variables;
|
|
|
|
|
! vm - the maximum physical speed;
|
2022-01-07 15:38:54 -03:00
|
|
|
|
! cm - the maximum eigenvalue;
|
2022-01-06 22:44:21 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_mhd_adi(qq, vm, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
use coordinates, only : nb, ne
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out) :: vm, cm
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2022-01-06 22:44:21 -03:00
|
|
|
|
real(kind=8) :: vl, vu, aa, cc, xx
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(3) :: bb
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vm = 0.0d+00
|
|
|
|
|
cm = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2022-01-06 22:44:21 -03:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
|
|
|
|
vl = minval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vu = maxval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vm = max(vm, abs(vl), abs(vu))
|
|
|
|
|
|
|
|
|
|
aa = adiabatic_index * qq(ipr,i,j,k) / qq(idn,i,j,k)
|
|
|
|
|
bb = qq(ibx:ibz,i,j,k) * qq(ibx:ibz,i,j,k) / qq(idn,i,j,k)
|
|
|
|
|
xx = aa + bb(1) + bb(2) + bb(3)
|
|
|
|
|
cc = max(0.0d+00, xx**2 - 4.0d+00 * aa * bb(1))
|
|
|
|
|
cc = sqrt(5.0d-01 * (xx + sqrt(cc)))
|
2022-01-07 15:38:54 -03:00
|
|
|
|
cm = max(cm, abs(vl - cc), abs(vu + cc))
|
2022-01-06 22:44:21 -03:00
|
|
|
|
end do
|
|
|
|
|
end do
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine get_maximum_speeds_mhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2014-03-06 14:19:31 -03:00
|
|
|
|
! subroutine ESYSTEM_ROE_MHD_ADI:
|
|
|
|
|
! ------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine computes eigenvalues and eigenvectors for a given set of
|
|
|
|
|
! equations and input variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! x - ratio of the perpendicular magnetic field component difference
|
|
|
|
|
! y - ratio of the density
|
|
|
|
|
! q - the intermediate Roe state vector;
|
|
|
|
|
! c - the vector of eigenvalues;
|
|
|
|
|
! r - the matrix of right eigenvectors;
|
|
|
|
|
! l - the matrix of left eigenvectors;
|
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! [1] Stone, J. M. & Gardiner, T. A.,
|
|
|
|
|
! "ATHENA: A New Code for Astrophysical MHD",
|
|
|
|
|
! The Astrophysical Journal Suplement Series, 2008, 178, pp. 137-177
|
|
|
|
|
! [2] Balsara, D. S.
|
|
|
|
|
! "Linearized Formulation of the Riemann Problem for Adiabatic and
|
|
|
|
|
! Isothermal Magnetohydrodynamics",
|
|
|
|
|
! The Astrophysical Journal Suplement Series, 1998, 116, pp. 119-131
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine esystem_roe_mhd_adi(x, y, q, c, r, l)
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 18:10:07 -02:00
|
|
|
|
real(kind=8) , intent(in) :: x, y
|
|
|
|
|
real(kind=8), dimension(:) , intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:) , intent(inout) :: c
|
|
|
|
|
real(kind=8), dimension(:,:), intent(inout) :: l, r
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
logical , save :: first = .true.
|
|
|
|
|
real(kind=8) , save :: gammam2
|
|
|
|
|
real(kind=8), dimension(9,9), save :: lvec, rvec
|
|
|
|
|
!$omp threadprivate(first, gammam2, lvec, rvec)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
real(kind=8) :: ca, ca2, cf, cf2, cs, cs2, cf2_cs2, ct2
|
|
|
|
|
real(kind=8) :: v2, br2, br, br2s, brs, hp
|
|
|
|
|
real(kind=8) :: tsum, tdif, twid_a2, twid_a
|
|
|
|
|
real(kind=8) :: bty, btz, btys, btzs, bt2s, vbet
|
|
|
|
|
real(kind=8) :: alf, als, af_prime, as_prime
|
|
|
|
|
real(kind=8) :: sqrtd, sgn, qf, qs, afpbb, aspbb
|
|
|
|
|
real(kind=8) :: qa, qb, qc, qd, q2s, q3s
|
|
|
|
|
real(kind=8) :: norm, cff, css, af, as, afpb, aspb, vqstr
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
real(kind=8), parameter :: eps = epsilon(1.0d+00)
|
2021-12-15 12:35:02 -03:00
|
|
|
|
|
2014-03-06 14:19:31 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
if (first) then
|
2020-08-16 16:41:28 -03:00
|
|
|
|
gammam2 = adiabatic_index - 2.0d+00
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
lvec(:, : ) = 0.0d+00
|
|
|
|
|
rvec(:, : ) = 0.0d+00
|
|
|
|
|
rvec(4,idn) = 1.0d+00
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
first = .false.
|
2021-12-15 12:35:02 -03:00
|
|
|
|
end if
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
! coefficients
|
2014-03-06 14:19:31 -03:00
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
ca2 = q(ibx) * q(ibx) / q(idn)
|
|
|
|
|
ca = sqrt(ca2)
|
|
|
|
|
v2 = sum(q(ivx:ivz)**2)
|
|
|
|
|
br2 = sum(q(iby:ibz)**2)
|
|
|
|
|
br2s = (gammam1 - gammam2 * y) * br2
|
|
|
|
|
hp = q(ien) - (ca2 + br2 / q(idn))
|
|
|
|
|
twid_a2 = max(eps, (gammam1 * (hp - 0.5d+00 * v2) - gammam2 * x))
|
|
|
|
|
ct2 = br2s / q(idn)
|
|
|
|
|
tsum = ca2 + ct2 + twid_a2
|
|
|
|
|
tdif = ca2 + ct2 - twid_a2
|
|
|
|
|
cf2_cs2 = sqrt((tdif * tdif + 4.0d+00 * twid_a2 * ct2))
|
|
|
|
|
cf2 = 0.5d+00 * (tsum + cf2_cs2)
|
|
|
|
|
cf = sqrt(cf2)
|
|
|
|
|
cs2 = twid_a2 * ca2 / cf2
|
|
|
|
|
cs = sqrt(cs2)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
! eigenvalues
|
2014-03-06 14:19:31 -03:00
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
c(1) = q(ivx) - cf
|
|
|
|
|
c(2) = q(ivx) - ca
|
|
|
|
|
c(3) = q(ivx) - cs
|
|
|
|
|
c(4) = q(ivx)
|
|
|
|
|
c(5) = q(ivx)
|
|
|
|
|
c(6) = q(ivx) + cs
|
|
|
|
|
c(7) = q(ivx) + ca
|
|
|
|
|
c(8) = q(ivx) + cf
|
|
|
|
|
c(9) = c(8)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
! eigenvectors only for the case of waves propagating in both direction
|
2014-03-06 14:19:31 -03:00
|
|
|
|
!
|
2021-12-15 12:35:02 -03:00
|
|
|
|
if (c(1) >= 0.0d+00 .or. c(8) <= 0.0d+00) return
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
! remaining coefficients
|
2014-03-06 14:19:31 -03:00
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
br = sqrt(br2)
|
|
|
|
|
brs = sqrt(br2s)
|
|
|
|
|
if (abs(br) > 0.0d+00) then
|
|
|
|
|
bty = q(iby) / br
|
|
|
|
|
btz = q(ibz) / br
|
2020-08-06 18:31:14 -03:00
|
|
|
|
else
|
2021-12-15 16:45:33 -03:00
|
|
|
|
bty = 1.0d+00
|
|
|
|
|
btz = 0.0d+00
|
2014-03-06 14:19:31 -03:00
|
|
|
|
end if
|
2021-12-15 16:45:33 -03:00
|
|
|
|
btys = bty / sqrt(gammam1 - gammam2 * y)
|
|
|
|
|
btzs = btz / sqrt(gammam1 - gammam2 * y)
|
|
|
|
|
bt2s = btys * btys + btzs * btzs
|
|
|
|
|
vbet = q(ivy) * btys + q(ivz) * btzs
|
|
|
|
|
|
|
|
|
|
if ( .not. abs(cf2 - cs2) > 0.0d+00 ) then
|
|
|
|
|
alf = 1.0d+00
|
|
|
|
|
als = 0.0d+00
|
|
|
|
|
else if ( (twid_a2 - cs2) <= 0.0d+00 ) then
|
|
|
|
|
alf = 0.0d+00
|
|
|
|
|
als = 1.0d+00
|
|
|
|
|
else if ( (cf2 - twid_a2) <= 0.0d+00 ) then
|
|
|
|
|
alf = 1.0d+00
|
|
|
|
|
als = 0.0d+00
|
2014-03-06 14:19:31 -03:00
|
|
|
|
else
|
2021-12-15 16:45:33 -03:00
|
|
|
|
alf = sqrt((twid_a2 - cs2) / (cf2 - cs2))
|
|
|
|
|
als = sqrt((cf2 - twid_a2) / (cf2 - cs2))
|
2014-03-06 14:19:31 -03:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
sqrtd = sqrt(q(idn))
|
2021-12-15 16:45:33 -03:00
|
|
|
|
sgn = sign(1.0d+00, q(ibx))
|
|
|
|
|
twid_a = sqrt(twid_a2)
|
|
|
|
|
qf = cf * alf * sgn
|
|
|
|
|
qs = cs * als * sgn
|
|
|
|
|
af_prime = twid_a * alf / sqrtd
|
|
|
|
|
as_prime = twid_a * als / sqrtd
|
|
|
|
|
afpbb = af_prime * brs * bt2s
|
|
|
|
|
aspbb = as_prime * brs * bt2s
|
|
|
|
|
|
|
|
|
|
! === update the varying elements of the right eigenvectors matrix
|
|
|
|
|
!
|
|
|
|
|
rvec(1,idn) = alf
|
|
|
|
|
rvec(3,idn) = als
|
|
|
|
|
rvec(6,idn) = als
|
|
|
|
|
rvec(8,idn) = alf
|
|
|
|
|
|
|
|
|
|
rvec(1,ivx) = alf * c(1)
|
|
|
|
|
rvec(3,ivx) = als * c(3)
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(4,ivx) = q(ivx)
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(6,ivx) = als * c(6)
|
|
|
|
|
rvec(8,ivx) = alf * c(8)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
qa = alf * q(ivy)
|
|
|
|
|
qb = als * q(ivy)
|
|
|
|
|
qc = qs * btys
|
|
|
|
|
qd = qf * btys
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(1,ivy) = qa + qc
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(2,ivy) = - btz
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(3,ivy) = qb - qd
|
|
|
|
|
rvec(4,ivy) = q(ivy)
|
|
|
|
|
rvec(6,ivy) = qb + qd
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(7,ivy) = btz
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(8,ivy) = qa - qc
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
qa = alf * q(ivz)
|
|
|
|
|
qb = als * q(ivz)
|
|
|
|
|
qc = qs * btzs
|
|
|
|
|
qd = qf * btzs
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(1,ivz) = qa + qc
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(2,ivz) = bty
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(3,ivz) = qb - qd
|
|
|
|
|
rvec(4,ivz) = q(ivz)
|
|
|
|
|
rvec(6,ivz) = qb + qd
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(7,ivz) = - bty
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(8,ivz) = qa - qc
|
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(1,ipr) = alf * (hp - q(ivx) * cf) + qs * vbet + aspbb
|
|
|
|
|
rvec(2,ipr) = -(q(ivy) * btz - q(ivz) * bty)
|
|
|
|
|
rvec(3,ipr) = als * (hp - q(ivx) * cs) - qf * vbet - afpbb
|
|
|
|
|
rvec(4,ipr) = 0.5d+00 * v2 + gammam2 * x / gammam1
|
|
|
|
|
rvec(6,ipr) = als * (hp + q(ivx) * cs) + qf * vbet - afpbb
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(7,ipr) = - rvec(2,ipr)
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(8,ipr) = alf * (hp + q(ivx) * cf) - qs * vbet + aspbb
|
2021-12-15 12:35:02 -03:00
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(1,iby) = as_prime * btys
|
|
|
|
|
rvec(2,iby) = - btz * sgn / sqrtd
|
|
|
|
|
rvec(3,iby) = - af_prime * btys
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(6,iby) = rvec(3,iby)
|
|
|
|
|
rvec(7,iby) = rvec(2,iby)
|
|
|
|
|
rvec(8,iby) = rvec(1,iby)
|
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
rvec(1,ibz) = as_prime * btzs
|
|
|
|
|
rvec(2,ibz) = bty * sgn / sqrtd
|
|
|
|
|
rvec(3,ibz) = - af_prime * btzs
|
2021-12-15 12:35:02 -03:00
|
|
|
|
rvec(6,ibz) = rvec(3,ibz)
|
|
|
|
|
rvec(7,ibz) = rvec(2,ibz)
|
|
|
|
|
rvec(8,ibz) = rvec(1,ibz)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
2021-12-15 16:45:33 -03:00
|
|
|
|
! === update the varying elements of the left eigenvectors matrix
|
|
|
|
|
!
|
|
|
|
|
norm = 2.0d+00 * twid_a2
|
|
|
|
|
cff = alf * cf / norm
|
|
|
|
|
css = als * cs / norm
|
|
|
|
|
qf = qf / norm
|
|
|
|
|
qs = qs / norm
|
|
|
|
|
af = af_prime * q(idn) / norm
|
|
|
|
|
as = as_prime * q(idn) / norm
|
|
|
|
|
afpb = af_prime * brs / norm
|
|
|
|
|
aspb = as_prime * brs / norm
|
|
|
|
|
|
|
|
|
|
norm = norm / gammam1
|
|
|
|
|
alf = alf / norm
|
|
|
|
|
als = als / norm
|
|
|
|
|
q2s = btys / bt2s
|
|
|
|
|
q3s = btzs / bt2s
|
|
|
|
|
vqstr = (q(ivy) * q2s + q(ivz) * q3s)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! left-going fast wave
|
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
lvec(idn,1) = alf * (v2 - hp) + cff * (cf + q(ivx)) - qs * vqstr - aspb
|
|
|
|
|
lvec(ipr,1) = alf
|
|
|
|
|
lvec(ivx,1) = - alf * q(ivx) - cff
|
|
|
|
|
lvec(ivy,1) = - alf * q(ivy) + qs * q2s
|
|
|
|
|
lvec(ivz,1) = - alf * q(ivz) + qs * q3s
|
|
|
|
|
lvec(iby,1) = as * q2s - alf * q(iby)
|
|
|
|
|
lvec(ibz,1) = as * q3s - alf * q(ibz)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! left-going Alfvèn wave
|
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
lvec(idn,2) = 5.0d-01 * (q(ivy) * btz - q(ivz) * bty)
|
|
|
|
|
lvec(ivy,2) = - 5.0d-01 * btz
|
|
|
|
|
lvec(ivz,2) = 5.0d-01 * bty
|
|
|
|
|
lvec(iby,2) = - 5.0d-01 * sqrtd * btz * sgn
|
|
|
|
|
lvec(ibz,2) = 5.0d-01 * sqrtd * bty * sgn
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! left-going slow wave
|
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
lvec(idn,3) = als * (v2 - hp) + css * (cs + q(ivx)) + qf * vqstr + afpb
|
|
|
|
|
lvec(ipr,3) = als
|
|
|
|
|
lvec(ivx,3) = - als * q(ivx) - css
|
|
|
|
|
lvec(ivy,3) = - als * q(ivy) - qf * q2s
|
|
|
|
|
lvec(ivz,3) = - als * q(ivz) - qf * q3s
|
|
|
|
|
lvec(iby,3) = - af * q2s - als * q(iby)
|
|
|
|
|
lvec(ibz,3) = - af * q3s - als * q(ibz)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! entropy wave
|
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
lvec(idn,4) = 1.0d+00 - (5.0d-01 * v2 - gammam2 * x / gammam1) / twid_a2
|
|
|
|
|
lvec(ipr,4) = - 1.0d+00 / twid_a2
|
|
|
|
|
lvec(ivx,4) = q(ivx) / twid_a2
|
|
|
|
|
lvec(ivy,4) = q(ivy) / twid_a2
|
|
|
|
|
lvec(ivz,4) = q(ivz) / twid_a2
|
|
|
|
|
lvec(iby,4) = q(iby) / twid_a2
|
|
|
|
|
lvec(ibz,4) = q(ibz) / twid_a2
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! right-going slow wave
|
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
lvec(idn,6) = als * (v2 - hp) + css * (cs - q(ivx)) - qf * vqstr + afpb
|
|
|
|
|
lvec(ipr,6) = als
|
|
|
|
|
lvec(ivx,6) = - als * q(ivx) + css
|
|
|
|
|
lvec(ivy,6) = - als * q(ivy) + qf * q2s
|
|
|
|
|
lvec(ivz,6) = - als * q(ivz) + qf * q3s
|
2021-12-15 12:35:02 -03:00
|
|
|
|
lvec(iby,6) = lvec(iby,3)
|
|
|
|
|
lvec(ibz,6) = lvec(ibz,3)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! right-going Alfvèn wave
|
|
|
|
|
!
|
2021-12-15 12:35:02 -03:00
|
|
|
|
lvec(idn,7) = - lvec(idn,2)
|
|
|
|
|
lvec(ivy,7) = - lvec(ivy,2)
|
|
|
|
|
lvec(ivz,7) = - lvec(ivz,2)
|
|
|
|
|
lvec(iby,7) = lvec(iby,2)
|
|
|
|
|
lvec(ibz,7) = lvec(ibz,2)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! right-going fast wave
|
|
|
|
|
!
|
2021-12-15 16:45:33 -03:00
|
|
|
|
lvec(idn,8) = alf * (v2 - hp) + cff * (cf - q(ivx)) + qs * vqstr - aspb
|
|
|
|
|
lvec(ipr,8) = alf
|
|
|
|
|
lvec(ivx,8) = - alf * q(ivx) + cff
|
|
|
|
|
lvec(ivy,8) = - alf * q(ivy) - qs * q2s
|
|
|
|
|
lvec(ivz,8) = - alf * q(ivz) - qs * q3s
|
2021-12-15 12:35:02 -03:00
|
|
|
|
lvec(iby,8) = lvec(iby,1)
|
|
|
|
|
lvec(ibz,8) = lvec(ibz,1)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
! copy matrices of eigenvectors
|
|
|
|
|
!
|
2021-12-15 12:35:02 -03:00
|
|
|
|
l(:,:) = lvec(:,:)
|
|
|
|
|
r(:,:) = rvec(:,:)
|
2014-03-06 14:19:31 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine esystem_roe_mhd_adi
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
! ADIABATIC SPECIAL RELATIVITY HYDRODYNAMIC EQUATIONS
|
|
|
|
|
!
|
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine PRIM2CONS_SRHD_ADI:
|
|
|
|
|
! -----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts primitive variables to their corresponding
|
|
|
|
|
! conservative representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the output array of conservative variables;
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! s - an optional flag indicating that passive scalars have
|
|
|
|
|
! to be calculated too;
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_srhd_adi(q, u, s)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
integer :: i, p
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8) :: vv, vm, vs, ww
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! iterate over all positions
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! calculate the square of velocity, the Lorentz factor and specific enthalpy
|
|
|
|
|
!
|
|
|
|
|
vv = sum(q(ivx:ivz,i) * q(ivx:ivz,i))
|
|
|
|
|
vm = 1.0d+00 - vv
|
|
|
|
|
vs = sqrt(vm)
|
|
|
|
|
ww = (q(idn,i) + q(ipr,i) / gammaxi) / vm
|
|
|
|
|
|
|
|
|
|
! calculate conservative variables
|
|
|
|
|
!
|
|
|
|
|
u(idn,i) = q(idn,i) / vs
|
|
|
|
|
u(imx,i) = ww * q(ivx,i)
|
|
|
|
|
u(imy,i) = ww * q(ivy,i)
|
|
|
|
|
u(imz,i) = ww * q(ivz,i)
|
|
|
|
|
u(ien,i) = ww - q(ipr,i) - u(idn,i)
|
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
end do
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! update primitive passive scalars
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0 .and. present(s)) then
|
|
|
|
|
if (s) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
u(p,:) = q(p,:) * u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine prim2cons_srhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine CONS2PRIM_SRHD_ADI:
|
|
|
|
|
! -----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts conservative variables to their corresponding
|
|
|
|
|
! primitive representation using an interative method.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! q - the output array of primitive variables;
|
2021-11-09 13:21:32 -03:00
|
|
|
|
! s - the status flag;
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_srhd_adi(u, q, s)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use helpers, only : print_message
|
2018-01-16 10:10:10 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical :: info
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8) :: mm, bb, mb, en, dn
|
2015-02-22 13:09:03 -03:00
|
|
|
|
real(kind=8) :: w , vv, vm, vs
|
2018-01-16 10:10:10 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
2018-01-16 10:10:10 -02:00
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::cons2prim_srhd_adi()'
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 0
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
do i = 1, size(u,2)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! prepare variables which do not change during the Newton-Ralphson iterations
|
|
|
|
|
!
|
|
|
|
|
mm = sum(u(imx:imz,i) * u(imx:imz,i))
|
|
|
|
|
en = u(ien,i) + u(idn,i)
|
|
|
|
|
dn = u(idn,i)
|
|
|
|
|
|
2018-01-17 13:19:56 -02:00
|
|
|
|
! find the exact W using the Newton-Ralphson interative method
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
call nr_iterate(mm, bb, mb, en, dn, w, vv, info)
|
|
|
|
|
|
|
|
|
|
! if info is .true., the solution was found
|
|
|
|
|
!
|
|
|
|
|
if (info) then
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! prepare coefficients
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
vm = 1.0d+00 - vv
|
|
|
|
|
vs = sqrt(vm)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! calculate the primitive variables
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
q(idn,i) = dn * vs
|
|
|
|
|
q(ivx,i) = u(imx,i) / w
|
|
|
|
|
q(ivy,i) = u(imy,i) / w
|
|
|
|
|
q(ivz,i) = u(imz,i) / w
|
|
|
|
|
q(ipr,i) = w - en
|
|
|
|
|
|
2018-01-16 10:10:10 -02:00
|
|
|
|
else ! cannot find physical solution
|
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Conversion to physical primitive state failed!")
|
|
|
|
|
write(msg,"(a,5(1x,1es24.16e3))") "U = ", u(:,i)
|
|
|
|
|
call print_message(loc, msg)
|
|
|
|
|
write(msg,"(a,3(1x,1es24.16e3))") "D, |m|², E = ", dn, mm, en
|
|
|
|
|
call print_message(loc, msg)
|
2015-02-22 19:31:28 -03:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
2015-02-22 19:31:28 -03:00
|
|
|
|
|
2018-01-16 10:10:10 -02:00
|
|
|
|
end if
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
end do
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
! update primitive passive scalars
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
q(p,:) = u(p,:) / u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine cons2prim_srhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine FLUXSPEED_SRHD_ADI:
|
|
|
|
|
! -----------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine calculates physical fluxes and characteristic speeds from a
|
|
|
|
|
! given equation system.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! f - the output vector of fluxes;
|
|
|
|
|
! c - the output vector of left- and right-going characteristic speeds;
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! [1] Mignone, A., Bodo, G.,
|
|
|
|
|
! "An HLLC Riemann solver for relativistic flows - I. Hydrodynamics",
|
|
|
|
|
! Monthly Notices of the Royal Astronomical Society, 2005, 364, 126-136
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_srhd_adi(q, u, f, c)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
integer :: i
|
|
|
|
|
real(kind=8) :: vv, ww, c2, ss, cc, fc
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
! calculate the relativistic hydrodynamic fluxes (eq. 2 in [1])
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
f(idn,i) = u(idn,i) * q(ivx,i)
|
|
|
|
|
f(imx,i) = u(imx,i) * q(ivx,i) + q(ipr,i)
|
2015-02-08 17:38:28 -02:00
|
|
|
|
f(imy,i) = u(imy,i) * q(ivx,i)
|
|
|
|
|
f(imz,i) = u(imz,i) * q(ivx,i)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
f(ien,i) = u(imx,i) - f(idn,i)
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! calculate characteristic speeds (eq. 23 in [1])
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (present(c)) then
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
ww = q(idn,i) + q(ipr,i) / gammaxi
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c2 = adiabatic_index * q(ipr,i) / ww
|
2020-02-19 06:13:00 -03:00
|
|
|
|
vv = sum(q(ivx:ivz,i) * q(ivx:ivz,i))
|
|
|
|
|
ss = c2 * (1.0d+00 - vv) / (1.0d+00 - c2)
|
|
|
|
|
fc = 1.0d+00 + ss
|
|
|
|
|
cc = sqrt(ss * (fc - q(ivx,i)**2))
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = (q(ivx,i) - cc) / fc
|
|
|
|
|
c(2,i) = (q(ivx,i) + cc) / fc
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
|
|
|
|
end if
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine fluxspeed_srhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! function MAXSPEED_SRHD_ADI:
|
|
|
|
|
! --------------------------
|
|
|
|
|
!
|
|
|
|
|
! Function scans the variable array and returns the maximum speed in within.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the array of primitive variables;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
function maxspeed_srhd_adi(qq) result(maxspeed)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
use coordinates, only : nb, ne
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
real(kind=8) :: maxspeed
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2015-02-06 09:02:56 -02:00
|
|
|
|
real(kind=8) :: vv, v, cc, ww, c2, ss, fc
|
2022-01-08 10:45:02 -03:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
maxspeed = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2019-02-05 14:40:45 -02:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! calculate the velocity amplitude
|
|
|
|
|
!
|
|
|
|
|
vv = sum(qq(ivx:ivz,i,j,k) * qq(ivx:ivz,i,j,k))
|
|
|
|
|
v = sqrt(vv)
|
|
|
|
|
|
|
|
|
|
! calculate the square of the sound speed
|
|
|
|
|
!
|
|
|
|
|
ww = qq(idn,i,j,k) + qq(ipr,i,j,k) / gammaxi
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c2 = adiabatic_index * qq(ipr,i,j,k) / ww
|
2015-02-06 09:02:56 -02:00
|
|
|
|
ss = c2 * (1.0d+00 - vv) / (1.0d+00 - c2)
|
|
|
|
|
fc = 1.0d+00 + ss
|
|
|
|
|
cc = sqrt(ss * (fc - vv))
|
|
|
|
|
|
|
|
|
|
! calculate the maximum of speed
|
|
|
|
|
!
|
|
|
|
|
maxspeed = max(maxspeed, (v + cc) / fc)
|
|
|
|
|
|
2019-02-05 14:40:45 -02:00
|
|
|
|
end do ! i = nb, ne
|
|
|
|
|
end do ! j = nb, ne
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do ! k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end function maxspeed_srhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! subroutine GET_MAXIMUM_SPEEDS_SRHD_ADI:
|
|
|
|
|
! --------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine determines the maximum characteristic speed and eigenvalue
|
|
|
|
|
! in the input array of primitive variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the input array of primitive variables;
|
|
|
|
|
! vm - the maximum physical speed;
|
2022-01-07 15:38:54 -03:00
|
|
|
|
! cm - the maximum eigenvalue;
|
2022-01-06 22:44:21 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_srhd_adi(qq, vm, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
use coordinates, only : nb, ne
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out) :: vm, cm
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2022-01-06 22:44:21 -03:00
|
|
|
|
real(kind=8) :: vl, vu, vv, ww, aa, cc, ss, fc
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vm = 0.0d+00
|
|
|
|
|
cm = 0.0d+00
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2022-01-06 22:44:21 -03:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
|
|
|
|
vl = minval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vu = maxval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vm = max(vm, abs(vl), abs(vu))
|
|
|
|
|
vv = sum(qq(ivx:ivz,i,j,k) * qq(ivx:ivz,i,j,k))
|
|
|
|
|
|
|
|
|
|
ww = qq(idn,i,j,k) + qq(ipr,i,j,k) / gammaxi
|
|
|
|
|
aa = adiabatic_index * qq(ipr,i,j,k) / ww
|
|
|
|
|
ss = aa * (1.0d+00 - vv) / (1.0d+00 - aa)
|
|
|
|
|
fc = 1.0d+00 + ss
|
|
|
|
|
cc = sqrt(ss * (fc - vv))
|
2022-01-07 15:38:54 -03:00
|
|
|
|
cm = max(cm, abs(vl - cc), abs(vu + cc))
|
2022-01-06 22:44:21 -03:00
|
|
|
|
end do
|
|
|
|
|
end do
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine get_maximum_speeds_srhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-19 19:00:23 -02:00
|
|
|
|
! subroutine NR_FUNCTION_SRHD_ADI_1D:
|
|
|
|
|
! ----------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine calculate the value of function
|
|
|
|
|
!
|
2015-02-22 13:07:09 -03:00
|
|
|
|
! F(W) = W - P(W) - E
|
2015-02-19 19:00:23 -02:00
|
|
|
|
!
|
|
|
|
|
! for a given enthalpy W. It is used to estimate the initial guess.
|
|
|
|
|
!
|
2015-02-22 13:07:09 -03:00
|
|
|
|
! The pressure is
|
|
|
|
|
!
|
|
|
|
|
! P(W) = (γ - 1)/γ (W - D / sqrt(1 - |v|²(W))) (1 - |v|²(W))
|
|
|
|
|
!
|
|
|
|
|
! and the squared velocity is
|
|
|
|
|
!
|
|
|
|
|
! |v|²(W) = |m|² / W²
|
|
|
|
|
!
|
|
|
|
|
! Optional derivative is returned
|
|
|
|
|
!
|
|
|
|
|
! dF(W)/dW = 1 - dP(W)/dW
|
|
|
|
|
!
|
2015-02-19 19:00:23 -02:00
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en, dn, w - input coefficients for |M|² E, D, and W, respectively;
|
|
|
|
|
! f - the value of function F(W);
|
2015-02-22 13:07:09 -03:00
|
|
|
|
! df - optional derivative F'(W);
|
2015-02-19 19:00:23 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-22 13:07:09 -03:00
|
|
|
|
subroutine nr_function_srhd_adi_1d(mm, en, dn, w, f, df)
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2015-02-22 13:07:09 -03:00
|
|
|
|
real(kind=8) , intent(in) :: mm, en, dn, w
|
|
|
|
|
real(kind=8) , intent(out) :: f
|
|
|
|
|
real(kind=8), optional, intent(out) :: df
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: vv, vm, vs
|
2015-02-19 19:00:23 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vv = mm / (w * w)
|
|
|
|
|
vm = 1.0d+00 - vv
|
|
|
|
|
vs = sqrt(vm)
|
2015-02-22 13:07:09 -03:00
|
|
|
|
f = (1.0d+00 - gammaxi * vm) * w + gammaxi * dn * vs - en
|
|
|
|
|
if (present(df)) then
|
|
|
|
|
df = 1.0d+00 - gammaxi * (1.0d+00 + (1.0d+00 - dn / (vs * w)) * vv)
|
|
|
|
|
end if
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_function_srhd_adi_1d
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! subroutine NR_ITERATE_SRHD_ADI_1DW:
|
|
|
|
|
! ----------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine finds a root W of equation
|
|
|
|
|
!
|
2015-02-20 10:54:55 -02:00
|
|
|
|
! F(W) = W - P(W) - E = 0
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
! using the Newton-Raphson 1Dw iterative method.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! bb, bm - input coefficients for |B|² and B.M, respectively;
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! w, vv - input/output coefficients W and |v|²;
|
2015-02-22 13:39:50 -03:00
|
|
|
|
! info - the flag is .true. if the solution was found, otherwise
|
|
|
|
|
! it is .false.;
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! Noble, S. C., Gammie, C. F., McKinney, J. C, Del Zanna, L.,
|
|
|
|
|
! "Primitive Variable Solvers for Conservative General Relativistic
|
|
|
|
|
! Magnetohydrodynamics",
|
|
|
|
|
! The Astrophysical Journal, 2006, vol. 641, pp. 626-637
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
subroutine nr_iterate_srhd_adi_1dw(mm, bb, mb, en, dn, w, vv, info)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use helpers, only : print_message
|
2018-01-16 11:44:08 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
implicit none
|
|
|
|
|
|
2015-02-22 13:09:03 -03:00
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
2015-02-06 09:02:56 -02:00
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical , intent(out) :: info
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
logical :: keep
|
|
|
|
|
integer :: it, cn
|
2015-02-19 19:00:23 -02:00
|
|
|
|
real(kind=8) :: wl, wu, fl, fu
|
2015-02-06 09:02:56 -02:00
|
|
|
|
real(kind=8) :: f, df, dw
|
2015-02-14 18:12:51 -02:00
|
|
|
|
real(kind=8) :: err
|
2018-01-16 11:44:08 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::nr_iterate_srhd_adi_1dw()'
|
2021-11-19 12:33:47 -03:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
! check if the state is physical; this can save some time if unphysical state
|
|
|
|
|
! is considered
|
|
|
|
|
!
|
|
|
|
|
wl = sqrt(mm + dn * dn)
|
|
|
|
|
if (en > wl) then
|
|
|
|
|
|
2015-02-19 19:00:23 -02:00
|
|
|
|
! prepare the initial brackets
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
wl = wl + gammaxi * pmin
|
|
|
|
|
wu = en + pmin
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! calculate the value of function for the lower bracket
|
2015-02-19 19:00:23 -02:00
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wl, fl)
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! the lower bracket gives negative function, so there is chance it bounds
|
|
|
|
|
! the root
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (fl < 0.0d+00) then
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! make sure that the upper bracket is larger than the lower one and
|
|
|
|
|
! the function has positive value
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (wu <= wl) wu = 2.0d+00 * wl
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! check if the brackets bound the root region, if not proceed until
|
|
|
|
|
! opposite function signs are found for the brackets
|
|
|
|
|
!
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wu, fu)
|
2018-01-17 13:19:56 -02:00
|
|
|
|
it = nrmax
|
|
|
|
|
keep = fl * fu > 0.0d+00
|
|
|
|
|
do while (keep)
|
|
|
|
|
it = it - 1
|
|
|
|
|
wl = wu
|
|
|
|
|
fl = fu
|
|
|
|
|
wu = 2.0d+00 * wu
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wu, fu)
|
|
|
|
|
keep = (fl * fu > 0.0d+00) .and. it > 0
|
|
|
|
|
end do
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! the upper bracket was found, so proceed with determining the root
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (it > 0 .and. fu >= 0.0d+00) then
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
! estimate the value of enthalpy close to the root and corresponding v²
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
w = wl - fl * (wu - wl) / (fu - fl)
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2015-02-06 09:02:56 -02:00
|
|
|
|
! initialize iteration parameters
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
info = .true.
|
|
|
|
|
keep = .true.
|
|
|
|
|
it = nrmax
|
|
|
|
|
cn = nrext
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! iterate using the Newton-Raphson method in order to find a root w of the
|
|
|
|
|
! function
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
do while(keep)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
! calculate F(W) and dF(W)/dW
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, w, f, df)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! update brackets
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (f > fl .and. f < 0.0d+00) then
|
|
|
|
|
wl = w
|
|
|
|
|
fl = f
|
|
|
|
|
end if
|
|
|
|
|
if (f < fu .and. f > 0.0d+00) then
|
|
|
|
|
wu = w
|
|
|
|
|
fu = f
|
|
|
|
|
end if
|
2015-02-19 11:35:34 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! calculate the increment dW, update the solution, and estimate the error
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
dw = f / df
|
|
|
|
|
w = w - dw
|
|
|
|
|
err = abs(dw / w)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! check the convergence, if the convergence is not reached, iterate until
|
|
|
|
|
! the maximum number of iteration is reached
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (err < tol) then
|
|
|
|
|
keep = cn > 0
|
|
|
|
|
cn = cn - 1
|
|
|
|
|
else
|
|
|
|
|
keep = it > 0
|
|
|
|
|
end if
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! if new W leaves the brackets, use the bisection method to estimate
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! the new guess
|
2015-02-06 09:02:56 -02:00
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (w < wl .or. w > wu) then
|
|
|
|
|
w = 0.5d+00 * (wl + wu)
|
|
|
|
|
end if
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2018-01-17 13:19:56 -02:00
|
|
|
|
it = it - 1
|
|
|
|
|
end do ! NR iterations
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2018-01-16 11:44:08 -02:00
|
|
|
|
! print information about failed convergence or unphysical variables
|
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
if (err >= tol) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Convergence not reached!")
|
|
|
|
|
write(msg,"(a,1x,1es24.16e3)") "Error: ", err
|
|
|
|
|
call print_message(loc, msg)
|
2018-01-17 13:19:56 -02:00
|
|
|
|
end if
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! calculate |V|² from W
|
2015-02-22 13:07:09 -03:00
|
|
|
|
!
|
2018-01-17 13:19:56 -02:00
|
|
|
|
vv = mm / (w * w)
|
2015-02-22 13:07:09 -03:00
|
|
|
|
|
2018-01-17 13:19:56 -02:00
|
|
|
|
else ! the upper brack not found
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Could not find the upper bracket!")
|
2018-01-17 13:19:56 -02:00
|
|
|
|
info = .false.
|
2018-01-16 11:44:08 -02:00
|
|
|
|
|
2018-01-17 13:19:56 -02:00
|
|
|
|
end if
|
|
|
|
|
|
2020-08-06 18:31:14 -03:00
|
|
|
|
else if (fl > 0.0d+00) then ! the root cannot be found, since it is below the lower bracket
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Positive function for lower bracket!")
|
2018-01-17 13:19:56 -02:00
|
|
|
|
info = .false.
|
2020-08-06 18:31:14 -03:00
|
|
|
|
else ! the lower bracket is a root, so return it
|
|
|
|
|
w = wl
|
|
|
|
|
info = .true.
|
2018-01-17 13:19:56 -02:00
|
|
|
|
end if
|
2018-01-16 11:44:08 -02:00
|
|
|
|
|
2018-01-17 13:19:56 -02:00
|
|
|
|
else ! the state is unphysical
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "The state is not physical!")
|
2018-01-16 11:44:08 -02:00
|
|
|
|
info = .false.
|
2015-02-14 18:12:51 -02:00
|
|
|
|
end if
|
2015-02-06 09:02:56 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_iterate_srhd_adi_1dw
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-19 11:38:16 -02:00
|
|
|
|
! subroutine NR_ITERATE_SRHD_ADI_2DWV:
|
|
|
|
|
! -----------------------------------
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! Subroutine finds a root (W,v²) of 2D equations
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! F(W,v²) = W - E - P(W,v²) = 0
|
|
|
|
|
! G(W,v²) = W² v² - m² = 0
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
! using the Newton-Raphson 2D iterative method.
|
|
|
|
|
!
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! All evaluated equations incorporate already the pressure of the form
|
|
|
|
|
!
|
|
|
|
|
! P(W,|v|²) = (γ - 1)/γ (W - Γ D) (1 - |v|²)
|
|
|
|
|
!
|
|
|
|
|
! in order to optimize calculations.
|
|
|
|
|
!
|
2015-02-14 17:20:03 -02:00
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! bb, bm - input coefficients for |B|² and B.M, respectively;
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! w, vv - input/output coefficients W and |v|²;
|
2015-02-22 13:39:50 -03:00
|
|
|
|
! info - the flag is .true. if the solution was found, otherwise
|
|
|
|
|
! it is .false.;
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! Noble, S. C., Gammie, C. F., McKinney, J. C, Del Zanna, L.,
|
|
|
|
|
! "Primitive Variable Solvers for Conservative General Relativistic
|
|
|
|
|
! Magnetohydrodynamics",
|
|
|
|
|
! The Astrophysical Journal, 2006, vol. 641, pp. 626-637
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
subroutine nr_iterate_srhd_adi_2dwv(mm, bb, mb, en, dn, w, vv, info)
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use helpers, only : print_message
|
|
|
|
|
|
2015-02-14 17:20:03 -02:00
|
|
|
|
implicit none
|
|
|
|
|
|
2015-02-22 13:09:03 -03:00
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
2015-02-14 17:20:03 -02:00
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical , intent(out) :: info
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
|
|
|
|
logical :: keep
|
|
|
|
|
integer :: it, cn
|
2015-02-19 19:00:23 -02:00
|
|
|
|
real(kind=8) :: wl, wu, fl, fu
|
2015-02-20 10:17:35 -02:00
|
|
|
|
real(kind=8) :: ww, vm, vs, gd, gv
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: f, dfw, dfv
|
|
|
|
|
real(kind=8) :: g, dgw, dgv
|
2015-02-14 17:20:03 -02:00
|
|
|
|
real(kind=8) :: det, jfw, jfv, jgw, jgv
|
|
|
|
|
real(kind=8) :: dw, dv
|
|
|
|
|
real(kind=8) :: err
|
2021-11-19 12:33:47 -03:00
|
|
|
|
|
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::nr_iterate_srhd_adi_2dwv()'
|
|
|
|
|
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-02-19 19:00:23 -02:00
|
|
|
|
! prepare the initial brackets
|
|
|
|
|
!
|
2015-02-22 12:48:43 -03:00
|
|
|
|
wl = sqrt(mm + dn * dn) + gammaxi * pmin
|
2015-02-19 19:00:23 -02:00
|
|
|
|
wu = en + pmin
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! make sure that the upper bracket is larger than the lower one
|
2015-02-22 12:48:43 -03:00
|
|
|
|
!
|
2015-02-27 18:19:40 -03:00
|
|
|
|
keep = wl >= wu
|
|
|
|
|
it = nrmax
|
|
|
|
|
do while(keep)
|
|
|
|
|
wu = 2.0d+00 * wu
|
|
|
|
|
it = it - 1
|
|
|
|
|
keep = (wl >= wu) .and. it > 0
|
2015-02-22 12:48:43 -03:00
|
|
|
|
end do
|
2015-02-27 18:19:40 -03:00
|
|
|
|
if (it <= 0) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Could not find the upper limit for enthalpy!")
|
2015-02-27 18:19:40 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
2015-02-22 12:48:43 -03:00
|
|
|
|
|
2015-02-22 20:55:47 -03:00
|
|
|
|
! check if the brackets bound the root region, if not proceed until
|
|
|
|
|
! opposite function signs are found for the brackets
|
2015-02-19 19:00:23 -02:00
|
|
|
|
!
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wl, fl)
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wu, fu)
|
2015-02-22 20:55:47 -03:00
|
|
|
|
|
2015-02-19 19:00:23 -02:00
|
|
|
|
keep = (fl * fu > 0.0d+00)
|
2015-02-20 13:39:33 -02:00
|
|
|
|
it = nrmax
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
do while (keep)
|
|
|
|
|
|
|
|
|
|
wl = wu
|
2015-02-22 19:38:06 -03:00
|
|
|
|
fl = fu
|
2015-02-19 19:00:23 -02:00
|
|
|
|
wu = 2.0d+00 * wu
|
|
|
|
|
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wu, fu)
|
|
|
|
|
|
|
|
|
|
it = it - 1
|
2015-02-22 19:38:06 -03:00
|
|
|
|
|
|
|
|
|
keep = (fl * fu > 0.0d+00) .and. it > 0
|
|
|
|
|
|
2015-02-19 19:00:23 -02:00
|
|
|
|
end do
|
2015-02-22 13:39:50 -03:00
|
|
|
|
if (it <= 0) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "No initial brackets found!")
|
2015-02-22 13:39:50 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
! estimate the value of enthalpy close to the root and corresponding v²
|
|
|
|
|
!
|
|
|
|
|
w = wl - fl * (wu - wl) / (fu - fl)
|
|
|
|
|
vv = mm / (w * w)
|
|
|
|
|
|
2015-02-14 17:20:03 -02:00
|
|
|
|
! initialize iteration parameters
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
info = .true.
|
2015-02-14 17:20:03 -02:00
|
|
|
|
keep = .true.
|
2015-02-20 13:39:33 -02:00
|
|
|
|
it = nrmax
|
|
|
|
|
cn = nrext
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! iterate using the Newton-Raphson method in order to find the roots W and |v|²
|
2015-02-14 17:20:03 -02:00
|
|
|
|
! of functions
|
|
|
|
|
!
|
|
|
|
|
do while(keep)
|
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate W², (1 - |v|²), and the Lorentz factor
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
ww = w * w
|
|
|
|
|
vm = 1.0d+00 - vv
|
2015-02-19 10:01:05 -02:00
|
|
|
|
vs = sqrt(vm)
|
2015-02-20 10:17:35 -02:00
|
|
|
|
gd = gammaxi * dn
|
|
|
|
|
gv = 1.0d+00 - gammaxi * vm
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate F(W,|v|²) and G(W,|v|²)
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
2015-02-20 10:17:35 -02:00
|
|
|
|
f = gv * w - en + gd * vs
|
2015-02-28 14:22:00 -03:00
|
|
|
|
g = vv * ww - mm
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate dF(W,|v|²)/dW and dF(W,|v|²)/d|v|²
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
2015-02-20 10:17:35 -02:00
|
|
|
|
dfw = gv
|
|
|
|
|
dfv = gammaxi * w - 0.5d+00 * gd / vs
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate dG(W,|v|²)/dW and dG(W,|v|²)/d|v|²
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
dgw = 2.0d+00 * vv * w
|
|
|
|
|
dgv = ww
|
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! invert the Jacobian J = | dF/dW, dF/d|v|² |
|
|
|
|
|
! | dG/dW, dG/d|v|² |
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
det = dfw * dgv - dfv * dgw
|
|
|
|
|
|
|
|
|
|
jfw = dgv / det
|
|
|
|
|
jgw = - dfv / det
|
|
|
|
|
jfv = - dgw / det
|
|
|
|
|
jgv = dfw / det
|
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate increments dW and d|v|²
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
dw = f * jfw + g * jgw
|
|
|
|
|
dv = f * jfv + g * jgv
|
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! correct W and |v|²
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
w = w - dw
|
|
|
|
|
vv = vv - dv
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! check if the new enthalpy and velocity are physical
|
2015-02-22 19:14:40 -03:00
|
|
|
|
!
|
|
|
|
|
if (w < wl) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
write(msg,"(a,1x,2es24.16e3)") "Enthalpy smaller than the limit: ", &
|
|
|
|
|
w, wl
|
|
|
|
|
call print_message(loc, msg)
|
2015-02-22 19:14:40 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (vv < 0.0d+00 .or. vv >= 1.0d+00) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
write(msg,"(a,1x,1es24.16e3)") "Unphysical speed |v|²: ", vv
|
|
|
|
|
call print_message(loc, msg)
|
2015-02-22 19:14:40 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! calculate the error
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
err = max(abs(dw / w), abs(dv))
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! check the convergence, if the convergence is not reached, iterate until
|
|
|
|
|
! the maximum number of iteration is reached
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
if (err < tol) then
|
2015-02-27 18:19:40 -03:00
|
|
|
|
keep = cn > 0
|
|
|
|
|
cn = cn - 1
|
|
|
|
|
else
|
|
|
|
|
keep = it > 0
|
2015-02-14 17:20:03 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! decrease the number of remaining iterations
|
|
|
|
|
!
|
|
|
|
|
it = it - 1
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
end do ! NR iterations
|
2015-02-14 17:20:03 -02:00
|
|
|
|
|
2015-02-22 20:55:47 -03:00
|
|
|
|
! print information about failed convergence or unphysical variables
|
2015-02-14 17:20:03 -02:00
|
|
|
|
!
|
|
|
|
|
if (err >= tol) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
write(msg,"(a,1x,1es24.16e3)") "Convergence not reached: ", err
|
|
|
|
|
call print_message(loc, msg)
|
2015-02-06 09:02:56 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-02-19 11:38:16 -02:00
|
|
|
|
end subroutine nr_iterate_srhd_adi_2dwv
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine NR_ITERATE_SRHD_ADI_2DWU:
|
|
|
|
|
! -----------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine finds a root (W,u²) of 2D equations
|
|
|
|
|
!
|
|
|
|
|
! F(W,u²) = (W - E - P(W,u²)) (u² + 1) = 0
|
2015-02-19 22:23:05 -02:00
|
|
|
|
! G(W,u²) = W² u² - (u² + 1) m² = 0
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
! using the Newton-Raphson 2D iterative method.
|
|
|
|
|
!
|
2015-02-20 09:28:31 -02:00
|
|
|
|
! All evaluated equations incorporate already the pressure of the form
|
|
|
|
|
!
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! P(W,|u|²) = (γ - 1)/γ (W - Γ D) / (1 + |u|²)
|
2015-02-20 09:28:31 -02:00
|
|
|
|
!
|
|
|
|
|
! in order to optimize calculations.
|
|
|
|
|
!
|
2015-02-19 12:35:03 -02:00
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
|
|
|
|
! bb, bm - input coefficients for |B|² and B.M, respectively;
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! w, vv - input/output coefficients W and |v|²;
|
2015-02-22 13:39:50 -03:00
|
|
|
|
! info - the flag is .true. if the solution was found, otherwise
|
|
|
|
|
! it is .false.;
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
subroutine nr_iterate_srhd_adi_2dwu(mm, bb, mb, en, dn, w, vv, info)
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2015-02-22 13:09:03 -03:00
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
2015-02-19 12:35:03 -02:00
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical , intent(out) :: info
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
logical :: keep
|
|
|
|
|
integer :: it, cn
|
2015-02-19 19:00:23 -02:00
|
|
|
|
real(kind=8) :: wl, wu, fl, fu
|
2015-02-20 09:28:31 -02:00
|
|
|
|
real(kind=8) :: ww, uu, up, gm, gd
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: f, dfw, dfu
|
|
|
|
|
real(kind=8) :: g, dgw, dgu
|
2015-02-19 12:35:03 -02:00
|
|
|
|
real(kind=8) :: det, jfw, jfu, jgw, jgu
|
|
|
|
|
real(kind=8) :: dw, du
|
|
|
|
|
real(kind=8) :: err
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-02-19 19:00:23 -02:00
|
|
|
|
! prepare the initial brackets
|
|
|
|
|
!
|
2015-02-22 12:48:43 -03:00
|
|
|
|
wl = sqrt(mm + dn * dn) + gammaxi * pmin
|
2015-02-19 19:00:23 -02:00
|
|
|
|
wu = en + pmin
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! make sure that the upper bracket is larger than the lower one
|
2015-02-22 12:48:43 -03:00
|
|
|
|
!
|
2015-02-27 18:19:40 -03:00
|
|
|
|
keep = wl >= wu
|
|
|
|
|
it = nrmax
|
|
|
|
|
do while(keep)
|
|
|
|
|
wu = 2.0d+00 * wu
|
|
|
|
|
it = it - 1
|
|
|
|
|
keep = (wl >= wu) .and. it > 0
|
2015-02-22 12:48:43 -03:00
|
|
|
|
end do
|
2015-02-27 18:19:40 -03:00
|
|
|
|
if (it <= 0) then
|
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(a,1x,a)") "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srhd_adi_1dw()"
|
|
|
|
|
write(*,"(a)" ) "Could not find the upper limit for enthalpy!"
|
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
2015-02-22 12:48:43 -03:00
|
|
|
|
|
2015-02-22 20:55:47 -03:00
|
|
|
|
! check if the brackets bound the root region, if not proceed until
|
|
|
|
|
! opposite function signs are found for the brackets
|
2015-02-19 19:00:23 -02:00
|
|
|
|
!
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wl, fl)
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wu, fu)
|
2015-02-22 20:55:47 -03:00
|
|
|
|
|
2015-02-19 19:00:23 -02:00
|
|
|
|
keep = (fl * fu > 0.0d+00)
|
2015-02-20 13:39:33 -02:00
|
|
|
|
it = nrmax
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
do while (keep)
|
|
|
|
|
|
|
|
|
|
wl = wu
|
2015-02-22 19:38:06 -03:00
|
|
|
|
fl = fu
|
2015-02-19 19:00:23 -02:00
|
|
|
|
wu = 2.0d+00 * wu
|
|
|
|
|
|
|
|
|
|
call nr_function_srhd_adi_1d(mm, en, dn, wu, fu)
|
|
|
|
|
|
|
|
|
|
it = it - 1
|
2015-02-22 19:38:06 -03:00
|
|
|
|
|
|
|
|
|
keep = (fl * fu > 0.0d+00) .and. it > 0
|
|
|
|
|
|
2015-02-19 19:00:23 -02:00
|
|
|
|
end do
|
2015-02-22 13:39:50 -03:00
|
|
|
|
if (it <= 0) then
|
2015-02-22 20:55:47 -03:00
|
|
|
|
write(*,*)
|
|
|
|
|
write(*,"(a,1x,a)") "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a)" ) "No initial brackets found!"
|
2015-02-22 13:39:50 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
|
|
|
|
! estimate the value of enthalpy close to the root and corresponding u²
|
|
|
|
|
!
|
|
|
|
|
w = wl - fl * (wu - wl) / (fu - fl)
|
2015-02-19 22:23:05 -02:00
|
|
|
|
uu = mm / (w * w - mm)
|
2015-02-19 19:00:23 -02:00
|
|
|
|
|
2015-02-19 12:35:03 -02:00
|
|
|
|
! initialize iteration parameters
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
info = .true.
|
2015-02-19 12:35:03 -02:00
|
|
|
|
keep = .true.
|
2015-02-20 13:39:33 -02:00
|
|
|
|
it = nrmax
|
|
|
|
|
cn = nrext
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! iterate using the Newton-Raphson method in order to find the roots W and |u|²
|
2015-02-19 12:35:03 -02:00
|
|
|
|
! of functions
|
|
|
|
|
!
|
|
|
|
|
do while(keep)
|
|
|
|
|
|
2015-02-20 09:28:31 -02:00
|
|
|
|
! calculate W², (1 + |u|²), and the Lorentz factor, and some repeated
|
|
|
|
|
! expressions
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
ww = w * w
|
|
|
|
|
up = 1.0d+00 + uu
|
|
|
|
|
gm = sqrt(up)
|
2015-02-20 09:28:31 -02:00
|
|
|
|
gd = gammaxi * dn
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate F(W,|u|²) and G(W,|u|²)
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
2015-02-20 09:28:31 -02:00
|
|
|
|
f = (up - gammaxi) * w - up * en + gm * gd
|
2015-02-19 22:23:05 -02:00
|
|
|
|
g = uu * ww - up * mm
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
2015-02-19 22:23:05 -02:00
|
|
|
|
! calculate dF(W,|u|²)/dW and dF(W,|u|²)/d|u|²
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
2015-02-19 17:17:38 -02:00
|
|
|
|
dfw = up - gammaxi
|
2015-02-20 09:28:31 -02:00
|
|
|
|
dfu = w - en + 0.5d+00 * gd / gm
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
2015-02-19 22:23:05 -02:00
|
|
|
|
! calculate dG(W,|u|²)/dW and dG(W,|u|²)/d|u|²
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
dgw = 2.0d+00 * uu * w
|
|
|
|
|
dgu = ww - mm
|
|
|
|
|
|
|
|
|
|
! invert the Jacobian J = | dF/dW, dF/d|u|² |
|
|
|
|
|
! | dG/dW, dG/d|u|² |
|
|
|
|
|
!
|
|
|
|
|
det = dfw * dgu - dfu * dgw
|
|
|
|
|
|
|
|
|
|
jfw = dgu / det
|
|
|
|
|
jgw = - dfu / det
|
|
|
|
|
jfu = - dgw / det
|
|
|
|
|
jgu = dfw / det
|
|
|
|
|
|
2015-02-19 22:23:05 -02:00
|
|
|
|
! calculate increments dW and d|u|²
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
dw = f * jfw + g * jgw
|
|
|
|
|
du = f * jfu + g * jgu
|
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! correct W and |u|²
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
w = w - dw
|
|
|
|
|
uu = uu - du
|
|
|
|
|
|
2015-02-22 20:55:47 -03:00
|
|
|
|
! check if the new enthalpy gives physical pressure and velocity
|
2015-02-22 19:14:40 -03:00
|
|
|
|
!
|
|
|
|
|
if (w < wl) then
|
2015-02-22 20:55:47 -03:00
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a,1x,2es24.16e3)") "Enthalpy smaller than the limit: ", w, wl
|
2015-02-22 19:14:40 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (uu < 0.0d+00) then
|
2015-02-22 20:55:47 -03:00
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Unphysical speed |u|²: ", uu
|
2015-02-22 19:14:40 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! calculate the error
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
err = max(abs(dw / w), abs(du))
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
! check the convergence, if the convergence is not reached, iterate until
|
|
|
|
|
! the maximum number of iteration is reached
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
if (err < tol) then
|
2015-02-27 18:19:40 -03:00
|
|
|
|
keep = cn > 0
|
|
|
|
|
cn = cn - 1
|
|
|
|
|
else
|
|
|
|
|
keep = it > 0
|
2015-02-19 12:35:03 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! decrease the number of remaining iterations
|
|
|
|
|
!
|
|
|
|
|
it = it - 1
|
|
|
|
|
|
2015-02-27 18:19:40 -03:00
|
|
|
|
end do ! NR iterations
|
2015-02-19 12:35:03 -02:00
|
|
|
|
|
2015-02-20 09:42:33 -02:00
|
|
|
|
! calculate |v|² from |u|²
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
vv = uu / (1.0d+00 + uu)
|
|
|
|
|
|
2015-02-22 20:55:47 -03:00
|
|
|
|
! print information about failed convergence or unphysical variables
|
2015-02-19 12:35:03 -02:00
|
|
|
|
!
|
|
|
|
|
if (err >= tol) then
|
2015-02-22 20:55:47 -03:00
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "WARNING in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Convergence not reached: ", err
|
2015-02-19 12:35:03 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_iterate_srhd_adi_2dwu
|
|
|
|
|
!
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
! ADIABATIC SPECIAL RELATIVITY MAGNETOHYDRODYNAMIC EQUATIONS
|
|
|
|
|
!
|
|
|
|
|
!*******************************************************************************
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine PRIM2CONS_SRMHD_ADI:
|
|
|
|
|
! ------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine converts primitive variables to their corresponding
|
|
|
|
|
! conservative representation.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the output array of conservative variables;
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! s - an optional flag indicating that passive scalars have
|
|
|
|
|
! to be calculated too;
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
subroutine prim2cons_srmhd_adi(q, u, s)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: q
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: u
|
2019-10-03 13:38:27 -03:00
|
|
|
|
logical , optional , intent(in) :: s
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2019-10-03 13:38:27 -03:00
|
|
|
|
integer :: i, p
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8) :: vv, bb, vb, vm, vs, ww, wt
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! iterate over all positions
|
|
|
|
|
!
|
2019-02-05 18:07:59 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! calculate the square of velocity, the quare of magnetic field, the scalar
|
|
|
|
|
! product of velocity and magnetic field, the Lorentz factor, specific and
|
|
|
|
|
! total enthalpies
|
|
|
|
|
!
|
|
|
|
|
vv = sum(q(ivx:ivz,i) * q(ivx:ivz,i))
|
|
|
|
|
bb = sum(q(ibx:ibz,i) * q(ibx:ibz,i))
|
|
|
|
|
vb = sum(q(ivx:ivz,i) * q(ibx:ibz,i))
|
|
|
|
|
vm = 1.0d+00 - vv
|
|
|
|
|
vs = sqrt(vm)
|
|
|
|
|
ww = (q(idn,i) + q(ipr,i) / gammaxi) / vm
|
|
|
|
|
wt = ww + bb
|
|
|
|
|
|
|
|
|
|
! calculate conservative variables
|
|
|
|
|
!
|
|
|
|
|
u(idn,i) = q(idn,i) / vs
|
|
|
|
|
u(imx,i) = wt * q(ivx,i) - vb * q(ibx,i)
|
|
|
|
|
u(imy,i) = wt * q(ivy,i) - vb * q(iby,i)
|
|
|
|
|
u(imz,i) = wt * q(ivz,i) - vb * q(ibz,i)
|
|
|
|
|
u(ibx,i) = q(ibx,i)
|
|
|
|
|
u(iby,i) = q(iby,i)
|
|
|
|
|
u(ibz,i) = q(ibz,i)
|
|
|
|
|
u(ibp,i) = q(ibp,i)
|
|
|
|
|
u(ien,i) = wt - q(ipr,i) - u(idn,i) - 0.5d+00 * (vm * bb + vb * vb)
|
|
|
|
|
|
2019-02-05 18:07:59 -02:00
|
|
|
|
end do
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2019-10-03 13:38:27 -03:00
|
|
|
|
! update primitive passive scalars
|
|
|
|
|
!
|
|
|
|
|
if (ns > 0 .and. present(s)) then
|
|
|
|
|
if (s) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
u(p,:) = q(p,:) * u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine prim2cons_srmhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-17 17:29:05 -02:00
|
|
|
|
! subroutine CONS2PRIM_SRMHD_ADI:
|
|
|
|
|
! ------------------------------
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
! Subroutine converts conservative variables to their corresponding
|
|
|
|
|
! primitive representation using an interative method.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! q - the output array of primitive variables;
|
2021-11-09 13:21:32 -03:00
|
|
|
|
! s - the status flag;
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
subroutine cons2prim_srmhd_adi(u, q, s)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use helpers, only : print_message
|
2018-01-16 10:17:05 -02:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
real(kind=8), dimension(:,:), intent(in) :: u
|
|
|
|
|
real(kind=8), dimension(:,:), intent(out) :: q
|
2021-11-09 13:21:32 -03:00
|
|
|
|
integer , intent(out) :: s
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical :: info
|
2019-10-03 13:27:47 -03:00
|
|
|
|
integer :: i, p
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8) :: mm, mb, bb, en, dn
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: w, wt, vv, vm, vs, fc
|
2018-01-16 10:17:05 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
2018-01-16 10:17:05 -02:00
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::cons2prim_srmhd_adi()'
|
2021-11-09 13:21:32 -03:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 0
|
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! iterate over all positions
|
|
|
|
|
!
|
2019-02-05 15:48:42 -02:00
|
|
|
|
do i = 1, size(u,2)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! prepare variables which do not change during the Newton-Ralphson iterations
|
|
|
|
|
! (|B|², |M|² and B.M and their multiplications)
|
|
|
|
|
!
|
|
|
|
|
mm = sum(u(imx:imz,i) * u(imx:imz,i))
|
|
|
|
|
mb = sum(u(imx:imz,i) * u(ibx:ibz,i))
|
|
|
|
|
bb = sum(u(ibx:ibz,i) * u(ibx:ibz,i))
|
|
|
|
|
en = u(ien,i) + u(idn,i)
|
|
|
|
|
dn = u(idn,i)
|
|
|
|
|
|
|
|
|
|
! find the exact W using an Newton-Ralphson interative method
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
call nr_iterate(mm, bb, mb, en, dn, w, vv, info)
|
|
|
|
|
|
|
|
|
|
! if info is .true., the solution was found
|
|
|
|
|
!
|
|
|
|
|
if (info) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! prepare coefficients
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
vm = 1.0d+00 - vv
|
|
|
|
|
vs = sqrt(vm)
|
|
|
|
|
wt = w + bb
|
|
|
|
|
fc = mb / w
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! calculate the primitive variables
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
q(idn,i) = dn * vs
|
|
|
|
|
q(ivx,i) = (u(imx,i) + fc * u(ibx,i)) / wt
|
|
|
|
|
q(ivy,i) = (u(imy,i) + fc * u(iby,i)) / wt
|
|
|
|
|
q(ivz,i) = (u(imz,i) + fc * u(ibz,i)) / wt
|
|
|
|
|
q(ibx,i) = u(ibx,i)
|
|
|
|
|
q(iby,i) = u(iby,i)
|
|
|
|
|
q(ibz,i) = u(ibz,i)
|
|
|
|
|
q(ibp,i) = u(ibp,i)
|
2015-05-02 13:00:37 -03:00
|
|
|
|
q(ipr,i) = w - en + 0.5d+00 * (bb + (bb * mm - mb * mb) / wt**2)
|
2015-02-22 13:39:50 -03:00
|
|
|
|
|
2015-05-02 11:47:24 -03:00
|
|
|
|
! check if the pressure is positive, if not, print a warning and replace it
|
|
|
|
|
! with the minimum allowed value pmin
|
|
|
|
|
!
|
|
|
|
|
if (q(ipr,i) <= 0.0d+00) then
|
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Conversion to physical primitive state " // &
|
|
|
|
|
"resulted in negative pressure!")
|
|
|
|
|
write(msg,"(a,9(1x,1es24.16e3))") "U = ", u(:,i)
|
|
|
|
|
call print_message(loc, msg)
|
|
|
|
|
write(msg,"(a,6(1x,1es24.16e3))") "D, |m|², m.B, |B|², E, W = ", &
|
|
|
|
|
dn, mm, mb, bb, en, w
|
|
|
|
|
call print_message(loc, msg)
|
2018-01-16 10:17:05 -02:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
2015-05-02 11:47:24 -03:00
|
|
|
|
|
|
|
|
|
end if ! p <= 0
|
|
|
|
|
|
2015-02-22 19:31:28 -03:00
|
|
|
|
else ! unphysical state
|
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Conversion to physical primitive state failed!")
|
|
|
|
|
write(msg,"(a,9(1x,1es24.16e3))") "U = ", u(:,i)
|
|
|
|
|
call print_message(loc, msg)
|
|
|
|
|
write(msg,"(a,5(1x,1es24.16e3))") "D, |m|², m.B, |B|², E = ", &
|
|
|
|
|
dn, mm, mb, bb, en
|
|
|
|
|
call print_message(loc, msg)
|
2018-01-16 10:17:05 -02:00
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
s = 1
|
|
|
|
|
go to 100
|
2015-02-22 19:31:28 -03:00
|
|
|
|
|
|
|
|
|
end if ! unphysical state
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2019-02-05 15:48:42 -02:00
|
|
|
|
end do
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2019-10-03 13:27:47 -03:00
|
|
|
|
if (ns > 0) then
|
|
|
|
|
do p = isl, isu
|
|
|
|
|
q(p,:) = u(p,:) / u(idn,:)
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
|
2021-11-09 13:21:32 -03:00
|
|
|
|
100 continue
|
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine cons2prim_srmhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine FLUXSPEED_SRMHD_ADI:
|
|
|
|
|
! ------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine calculates physical fluxes and characteristic speeds from a
|
|
|
|
|
! given equation system.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
! q - the input array of primitive variables;
|
|
|
|
|
! u - the input array of conservative variables;
|
|
|
|
|
! f - the output vector of fluxes;
|
|
|
|
|
! c - the output vector of left- and right-going characteristic speeds;
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! [1] Mignone, A., Bodo, G.,
|
|
|
|
|
! "An HLLC Riemann solver for relativistic flows -
|
|
|
|
|
! II. Magnetohydrodynamics",
|
|
|
|
|
! Monthly Notices of the Royal Astronomical Society,
|
|
|
|
|
! 2006, Volume 368, Pages 1040-1054
|
|
|
|
|
! [2] van der Holst, B., Keppens, R., Meliani, Z.
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! "A multidimentional grid-adaptive relativistic magnetofluid code",
|
|
|
|
|
! Computer Physics Communications, 2008, Volume 179, Pages 617-627
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
subroutine fluxspeed_srmhd_adi(q, u, f, c)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use algebra, only : quadratic, quartic
|
|
|
|
|
use helpers, only : print_message
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(:,:) , intent(in) :: q, u
|
|
|
|
|
real(kind=8), dimension(:,:) , intent(out) :: f
|
2020-02-19 06:13:00 -03:00
|
|
|
|
real(kind=8), dimension(:,:), optional, intent(out) :: c
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2020-08-06 18:31:14 -03:00
|
|
|
|
integer :: i, nr
|
2015-12-10 07:25:17 -02:00
|
|
|
|
real(kind=8) :: bb, vs
|
|
|
|
|
real(kind=8) :: bx, by, bz, pm, pt
|
2015-04-25 17:13:39 -03:00
|
|
|
|
real(kind=8) :: rh, v1, v2
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8) :: ca, cc, c2, gn, rt, zm, zp
|
|
|
|
|
real(kind=8) :: fa, fb, fc, fd, fe, ff, fg
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
real(kind=8), dimension(size(q,2)) :: vv, vm, vb, b2
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8), dimension(5) :: a
|
|
|
|
|
real(kind=8), dimension(4) :: x
|
2018-08-27 19:22:57 -03:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
2018-08-27 19:22:57 -03:00
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::fluxspeed_srmhd_adi()'
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! iterate over all positions
|
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! calculate the square of velocity, magnetic field and their scalar product
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
vv(i) = sum(q(ivx:ivz,i) * q(ivx:ivz,i))
|
|
|
|
|
bb = sum(q(ibx:ibz,i) * q(ibx:ibz,i))
|
|
|
|
|
vb(i) = sum(q(ivx:ivz,i) * q(ibx:ibz,i))
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! calculate (1 - |V|²)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
vm(i) = 1.0d+00 - vv(i)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! calculate magnetic field components of the magnetic four-vector divided by
|
|
|
|
|
! the Lorentz factor (eq. 3 in [1])
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
bx = q(ibx,i) * vm(i) + vb(i) * q(ivx,i)
|
|
|
|
|
by = q(iby,i) * vm(i) + vb(i) * q(ivy,i)
|
|
|
|
|
bz = q(ibz,i) * vm(i) + vb(i) * q(ivz,i)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! calculate magnetic and total pressures (eq. 6 in [1])
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
b2(i) = bb * vm(i) + vb(i) * vb(i)
|
|
|
|
|
pm = 0.5d+00 * b2(i)
|
|
|
|
|
pt = q(ipr,i) + pm
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! calculate the relativistic hydrodynamic fluxes (eq. 13 in [1])
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
f(idn,i) = u(idn,i) * q(ivx,i)
|
2015-04-25 17:13:39 -03:00
|
|
|
|
f(imx,i) = u(imx,i) * q(ivx,i) - q(ibx,i) * bx + pt
|
|
|
|
|
f(imy,i) = u(imy,i) * q(ivx,i) - q(ibx,i) * by
|
|
|
|
|
f(imz,i) = u(imz,i) * q(ivx,i) - q(ibx,i) * bz
|
2015-02-17 11:28:40 -02:00
|
|
|
|
f(ibx,i) = q(ibp,i)
|
|
|
|
|
f(ibp,i) = cmax2 * q(ibx,i)
|
|
|
|
|
f(iby,i) = q(ivx,i) * q(iby,i) - q(ibx,i) * q(ivy,i)
|
|
|
|
|
f(ibz,i) = q(ivx,i) * q(ibz,i) - q(ibx,i) * q(ivz,i)
|
|
|
|
|
f(ien,i) = u(imx,i) - f(idn,i)
|
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (present(c)) then
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
|
|
|
|
! calculate the characteristic speeds
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2019-02-05 17:26:29 -02:00
|
|
|
|
do i = 1, size(q,2)
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! check if the total velocity |V|² is larger than zero
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
if (vv(i) > 0.0d+00) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! calculate additional coefficients
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
rh = q(idn,i) + q(ipr,i) / gammaxi
|
|
|
|
|
vs = sqrt(vm(i))
|
2015-04-25 17:13:39 -03:00
|
|
|
|
|
|
|
|
|
! check if the normal component of magnetic field Bₓ is larger than zero
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2020-08-06 18:31:14 -03:00
|
|
|
|
if (abs(q(ibx,i)) > 0.0d+00) then ! Bₓ ≠ 0
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! prepare parameters for this case
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c2 = adiabatic_index * q(ipr,i) / rh
|
2015-12-10 07:25:17 -02:00
|
|
|
|
v1 = abs(q(ivx,i))
|
|
|
|
|
v2 = v1 * v1
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
fa = rh * (1.0d+00 - c2)
|
|
|
|
|
fb = c2 * (rh - vb(i) * vb(i)) + b2(i)
|
|
|
|
|
fc = sign(1.0d+00, q(ivx,i)) * q(ibx,i) * vs
|
|
|
|
|
fd = c2 * fc * fc
|
|
|
|
|
fe = 1.0d+00 - v2
|
|
|
|
|
ff = c2 * vb(i) * fc
|
|
|
|
|
fg = v1 * vs
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! prepare polynomial coefficients
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
a(5) = fa + fb * vm(i)
|
|
|
|
|
a(4) = 2.0d+00 * (ff * vm(i) + fb * fg)
|
|
|
|
|
a(3) = - fd * vm(i) + 4.0d+00 * ff * fg - fb * fe
|
|
|
|
|
a(2) = - 2.0d+00 * (fd * fg + fe * ff)
|
|
|
|
|
a(1) = fd * fe
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! call the quartic solver
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
nr = quartic(a(1:5), x(1:4))
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! convert eigenvalues to charasteristic speeds
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
x(1:nr) = sign(1.0d+00, q(ivx,i)) * (abs(v1) + x(1:nr) * vs)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
else ! Bₓ ≠ 0
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-04-25 17:13:39 -03:00
|
|
|
|
! special case when Bₓ = 0, then the quartic equation reduces to quadratic one
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
! prepare parameters for this case
|
|
|
|
|
!
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c2 = adiabatic_index * q(ipr,i) / rh
|
2015-12-10 07:25:17 -02:00
|
|
|
|
cc = (1.0d+00 - c2) / vm(i)
|
|
|
|
|
gn = b2(i) - c2 * vb(i) * vb(i)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! prepare polynomial coefficients
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
a(3) = rh * (c2 + cc) + gn
|
|
|
|
|
a(2) = - 2.0d+00 * rh * cc * q(ivx,i)
|
|
|
|
|
a(1) = rh * (cc * q(ivx,i)**2 - c2) - gn
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! solve the quadratic equation
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
nr = quadratic(a(1:3), x(1:2))
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
end if ! Bx ≠ 0
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
else ! |V|² > 0
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! special case when |V|² = 0 (Γ = 1), then the quartic equation reduces to
|
|
|
|
|
! bi-quartic one
|
|
|
|
|
!
|
|
|
|
|
! prepare parameters for this case
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
rh = q(idn,i) + q(ipr,i) / gammaxi
|
|
|
|
|
vs = sqrt(vm(i))
|
|
|
|
|
rt = rh + b2(i)
|
2020-08-16 16:41:28 -03:00
|
|
|
|
c2 = adiabatic_index * q(ipr,i) / rh
|
2015-12-10 07:25:17 -02:00
|
|
|
|
ca = (q(ibx,i) * vs + vb(i) * q(ivx,i) / vs)**2
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! prepare polynomial coefficients
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
a(3) = 1.0d+00
|
|
|
|
|
a(2) = - ((rh + ca) * c2 + b2(i)) / rt
|
|
|
|
|
a(1) = c2 * ca / rt
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! solve the bi-quartic equation
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
nr = quadratic(a(1:3), x(1:2))
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! compute the roots
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
if (nr > 0) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
zm = min(x(1), x(2))
|
|
|
|
|
zp = max(x(1), x(2))
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
if (zm >= 0.0d+00) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
zm = sqrt(zm)
|
|
|
|
|
zp = sqrt(zp)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
x(1) = zp
|
|
|
|
|
x(2) = zm
|
|
|
|
|
x(3) = - zm
|
|
|
|
|
x(4) = - zp
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
nr = 4
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
else
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
if (zp >= 0.0d+00) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
zp = sqrt(zp)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
x(1) = zp
|
|
|
|
|
x(2) = - zp
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
nr = 2
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
else
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
x(:) = 0.0d+00
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
nr = 0
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
end if ! |V|² > 0
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! find the minimum and maximum characteristic speeds
|
|
|
|
|
!
|
2015-12-10 07:25:17 -02:00
|
|
|
|
if (nr > 1) then
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = minval(x(1:nr))
|
|
|
|
|
c(2,i) = maxval(x(1:nr))
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2020-02-19 06:13:00 -03:00
|
|
|
|
if (max(abs(c(1,i)), abs(c(2,i))) >= 1.0d+00) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Estimation returned unphysical speeds!")
|
|
|
|
|
write(msg,"(a,5(1es24.16))") "A = ", a(1:5)
|
|
|
|
|
call print_message(loc, msg)
|
|
|
|
|
write(msg,"(a,1i2)") "N = ", nr
|
|
|
|
|
call print_message(loc, msg)
|
|
|
|
|
write(msg,"(a,4(1es24.16))") "X = ", x(1:4)
|
|
|
|
|
call print_message(loc, msg)
|
2015-12-10 07:25:17 -02:00
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
else
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! speed estimation failed, so we substitute the minimum and maximum physical
|
|
|
|
|
! speeds equal the speed of light
|
|
|
|
|
!
|
2020-02-19 06:13:00 -03:00
|
|
|
|
c(1,i) = - 1.0d+00
|
|
|
|
|
c(2,i) = 1.0d+00
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-12-10 07:25:17 -02:00
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2019-02-05 17:26:29 -02:00
|
|
|
|
end do
|
2015-12-10 07:25:17 -02:00
|
|
|
|
|
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine fluxspeed_srmhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-17 17:29:05 -02:00
|
|
|
|
! function MAXSPEED_SRMHD_ADI:
|
|
|
|
|
! ---------------------------
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
! Function scans the variable array and returns the maximum speed in within.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the array of primitive variables;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
function maxspeed_srmhd_adi(qq) result(maxspeed)
|
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input arguments
|
|
|
|
|
!
|
2019-02-05 09:34:51 -02:00
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
! return value
|
|
|
|
|
!
|
|
|
|
|
real(kind=8) :: maxspeed
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
maxspeed = 1.0d+00
|
|
|
|
|
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end function maxspeed_srmhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-06 22:44:21 -03:00
|
|
|
|
! subroutine GET_MAXIMUM_SPEEDS_SRMHD_ADI:
|
|
|
|
|
! ---------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine determines the maximum characteristic speed and eigenvalue
|
|
|
|
|
! in the input array of primitive variables.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! qq - the input array of primitive variables;
|
|
|
|
|
! vm - the maximum physical speed;
|
2022-01-07 15:38:54 -03:00
|
|
|
|
! cm - the maximum eigenvalue;
|
2022-01-06 22:44:21 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2022-01-07 15:38:54 -03:00
|
|
|
|
subroutine get_maximum_speeds_srmhd_adi(qq, vm, cm)
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
use coordinates, only : nb, ne
|
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), dimension(:,:,:,:), intent(in) :: qq
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) , intent(out) :: vm, cm
|
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
integer :: i, j, k
|
2022-01-07 15:38:54 -03:00
|
|
|
|
real(kind=8) :: vl, vu
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
vm = 0.0d+00
|
|
|
|
|
cm = 1.0d+00
|
2022-01-07 15:38:54 -03:00
|
|
|
|
|
2022-01-08 10:45:02 -03:00
|
|
|
|
#if NDIMS == 2
|
|
|
|
|
k = 1
|
|
|
|
|
#endif /* NDIMS == 2 */
|
2022-01-07 15:38:54 -03:00
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
do k = nb, ne
|
|
|
|
|
#endif /* NDIMS == 3 */
|
|
|
|
|
do j = nb, ne
|
|
|
|
|
do i = nb, ne
|
|
|
|
|
vl = minval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vu = maxval(qq(ivx:ivz,i,j,k))
|
|
|
|
|
vm = max(vm, abs(vl), abs(vu))
|
|
|
|
|
end do
|
|
|
|
|
end do
|
|
|
|
|
#if NDIMS == 3
|
|
|
|
|
end do
|
|
|
|
|
#endif /* NDIMS == 3 */
|
2022-01-06 22:44:21 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine get_maximum_speeds_srmhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! subroutine NR_VELOCITY_SRMHD_ADI_1D:
|
2015-02-17 18:15:11 -02:00
|
|
|
|
! -----------------------------------
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! Subroutine calculates the squared velocity
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! |V|²(W) = (|m|² W² + S² (2 W + |B|²)) / (W² (W² + |B|²)²)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! and its derivative
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! |V|²'(W) = - 2 (|m|² W³ + 3 S² W² + 3 S² |B|² W + S² |B|⁴)
|
|
|
|
|
! / (W³ (W² + |B|²)³)
|
2015-02-17 12:35:52 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! for a given enthalpy W.
|
2015-02-20 11:17:53 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! Arguments:
|
2015-02-20 11:17:53 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! mm, bb, mb, w - input coefficients for |M|², |B|², M.B, and W,
|
|
|
|
|
! respectively;
|
|
|
|
|
! vv, dv - the values of squared velocity |V|² and its derivative;
|
2015-02-20 11:17:53 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
!===============================================================================
|
2015-02-20 11:17:53 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
subroutine nr_velocity_srmhd_adi_1d(mm, bb, mb, w, vv, dv)
|
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, w
|
|
|
|
|
real(kind=8), intent(out) :: vv
|
|
|
|
|
real(kind=8), optional, intent(out) :: dv
|
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
real(kind=8) :: ss, ww, www, wt, wt2
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! temporary variables
|
|
|
|
|
!
|
|
|
|
|
ss = mb * mb
|
|
|
|
|
ww = w * w
|
|
|
|
|
www = ww * w
|
|
|
|
|
wt = w + bb
|
|
|
|
|
wt2 = wt * wt
|
|
|
|
|
|
|
|
|
|
! the function and its derivative
|
|
|
|
|
!
|
|
|
|
|
vv = (mm * ww + (w + wt) * ss) / (ww * wt2)
|
|
|
|
|
if (present(dv)) then
|
|
|
|
|
dv = - 2.0d+00 * (mm * www + (3.0d+00 * ww &
|
|
|
|
|
+ (2.0d+00 * w + wt) * bb) * ss) / (www * wt2 * wt)
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_velocity_srmhd_adi_1d
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-05-04 12:35:29 -03:00
|
|
|
|
! subroutine NR_PRESSURE_SRMHD_ADI_1D:
|
|
|
|
|
! -----------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine calculates the pressure function
|
|
|
|
|
!
|
|
|
|
|
! P(W) = W - E + ½ |B|² + ½ (|m|² |B|² - S²) / (W + |B|²)²
|
|
|
|
|
!
|
|
|
|
|
! and its derivative
|
|
|
|
|
!
|
|
|
|
|
! P'(W) = 1 - (|m|² |B|² - S²) / (W + |B|²)³
|
|
|
|
|
!
|
|
|
|
|
! for a given enthalpy W.
|
|
|
|
|
!
|
|
|
|
|
! This subroutine is used to find the minimum enthalpy for which the velocity
|
|
|
|
|
! is physical and the pressure is positive.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
2020-08-06 18:31:14 -03:00
|
|
|
|
! mm, bb, mb, en, w - input coefficients for |M|², |B|², M.B, E,
|
|
|
|
|
! and W, respectively;
|
|
|
|
|
! p, dp - the values for the function P(W) and its
|
|
|
|
|
! derivative P'(W);
|
2015-05-04 12:35:29 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2020-08-06 18:31:14 -03:00
|
|
|
|
subroutine nr_pressure_srmhd_adi_1d(mm, bb, mb, en, w, p, dp)
|
2015-05-04 12:35:29 -03:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) , intent(in) :: mm, bb, mb, en, w
|
2015-05-04 12:35:29 -03:00
|
|
|
|
real(kind=8) , intent(out) :: p
|
|
|
|
|
real(kind=8), optional, intent(out) :: dp
|
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
real(kind=8) :: wt, wd, ss, fn
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! temporary variables
|
|
|
|
|
!
|
|
|
|
|
wt = w + bb
|
|
|
|
|
wd = wt * wt
|
|
|
|
|
ss = mb * mb
|
|
|
|
|
fn = (mm * bb - ss) / wd
|
|
|
|
|
|
|
|
|
|
! the pressure function and its derivative
|
|
|
|
|
!
|
|
|
|
|
p = w - en + 0.5d+00 * (bb + fn)
|
|
|
|
|
if (present(dp)) dp = 1.0d+00 - fn / wt
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_pressure_srmhd_adi_1d
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! subroutine NR_FUNCTION_SRMHD_ADI_1D:
|
|
|
|
|
! -----------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine calculates the energy function
|
|
|
|
|
!
|
2015-04-30 16:48:07 -03:00
|
|
|
|
! F(W) = W - P(W) + ½ |B|² + ½ (|m|² |B|² - S²) / (W + |B|²)² - E
|
2015-02-27 17:08:12 -03:00
|
|
|
|
!
|
|
|
|
|
! and its derivative
|
|
|
|
|
!
|
2015-04-30 16:48:07 -03:00
|
|
|
|
! F'(W) = 1 - dP(W)/dW - (|m|² |B|² - S²) / (W + |B|²)³
|
2015-02-27 17:08:12 -03:00
|
|
|
|
!
|
|
|
|
|
! for a given enthalpy W. It is used to estimate the initial guess.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, bb, mb, en, dn, w - input coefficients for |M|², |B|², M.B, E, D,
|
|
|
|
|
! and W, respectively;
|
|
|
|
|
! f, df - the values of F(W) and its derivative;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine nr_function_srmhd_adi_1d(mm, bb, mb, en, dn, w, f, df)
|
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn, w
|
|
|
|
|
real(kind=8), intent(out) :: f
|
|
|
|
|
real(kind=8), optional, intent(out) :: df
|
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2015-04-30 16:48:07 -03:00
|
|
|
|
real(kind=8) :: pr, dp, gm2, gm, dg
|
|
|
|
|
real(kind=8) :: ww, wt, wd, ss, sw, ws, fn, dv, ds
|
2015-02-27 17:08:12 -03:00
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! temporary variables
|
|
|
|
|
!
|
2015-04-30 16:48:07 -03:00
|
|
|
|
ww = w * w
|
|
|
|
|
wt = w + bb
|
|
|
|
|
wd = wt * wt
|
|
|
|
|
ss = mb * mb
|
|
|
|
|
sw = ss / ww
|
|
|
|
|
ws = (w + wt) * sw
|
|
|
|
|
fn = (mm * bb - ss) / wd
|
|
|
|
|
dv = wd - mm - ws
|
|
|
|
|
ds = sqrt(dv)
|
2015-02-27 17:08:12 -03:00
|
|
|
|
|
2015-04-30 16:48:07 -03:00
|
|
|
|
! calculate the Lorentz factor
|
|
|
|
|
!
|
|
|
|
|
gm2 = wd / dv
|
|
|
|
|
gm = wt / ds
|
|
|
|
|
|
|
|
|
|
! calculate the pressure P(W) and energy function F(W)
|
|
|
|
|
!
|
|
|
|
|
pr = gammaxi * (w - gm * dn) / gm2
|
|
|
|
|
f = w - pr - en + 0.5d+00 * (bb + fn)
|
|
|
|
|
|
|
|
|
|
! if desired, calculate the derivatives dP(W)/dW and dF(W)/dW
|
2015-02-27 17:08:12 -03:00
|
|
|
|
!
|
|
|
|
|
if (present(df)) then
|
2015-04-30 16:48:07 -03:00
|
|
|
|
|
|
|
|
|
dg = (1.0d+00 - wt * (wt - sw + ws / w) / dv) / ds
|
|
|
|
|
dp = gammaxi * (1.0d+00 - (2.0d+00 * w / gm - dn) * dg) / gm2
|
|
|
|
|
df = 1.0d+00 - dp - fn / wt
|
|
|
|
|
|
|
|
|
|
end if ! df present
|
2015-02-27 17:08:12 -03:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
2015-02-20 11:17:53 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
end subroutine nr_function_srmhd_adi_1d
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-04-27 18:42:43 -03:00
|
|
|
|
! subroutine NR_INITIAL_BRACKETS_SRMHD_ADI:
|
|
|
|
|
! ----------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine finds the initial brackets and initial guess from
|
|
|
|
|
! the positivity condition
|
|
|
|
|
!
|
2015-05-02 12:43:28 -03:00
|
|
|
|
! W³ + (5/2 |B|² - E) W² + 2 (|B|² - E) |B|² W
|
|
|
|
|
! + 1/2 [(|B|⁴ - 2 |B|² E + |m|²) |B|² - S²] > 0
|
2015-04-27 18:42:43 -03:00
|
|
|
|
!
|
2015-05-04 11:03:41 -03:00
|
|
|
|
! coming from the energy equation and
|
|
|
|
|
!
|
|
|
|
|
! W⁴ + 2 |B|² W³ - (|m|² + D² - |B|⁴) W²
|
|
|
|
|
! - (2 S² + D² |B|²) W - (S² + D² |B|²) |B|² > 0
|
|
|
|
|
!
|
|
|
|
|
! coming from the equation of state
|
|
|
|
|
!
|
|
|
|
|
! using analytical. It takes the maximum estimated root as the lower bracket.
|
|
|
|
|
! If the analytical estimation fails, the Newton-Raphson iterative method
|
|
|
|
|
! is used.
|
2015-04-27 18:42:43 -03:00
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
|
|
|
|
! bb, mb - input coefficients for |B|² and m.B, respectively;
|
|
|
|
|
! wl, wu - the lower and upper limits for the enthalpy;
|
|
|
|
|
! wc - the initial root guess;
|
|
|
|
|
! info - the flag is .true. if the initial brackets and guess were found,
|
|
|
|
|
! otherwise it is .false.;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine nr_initial_brackets_srmhd_adi(mm, bb, mb, en, dn &
|
|
|
|
|
, wl, wu, wc, fl, fu, info)
|
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use algebra, only : cubic_normalized, quartic
|
|
|
|
|
use helpers, only : print_message
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
|
|
|
|
real(kind=8), intent(out) :: wl, wu, wc, fl, fu
|
|
|
|
|
logical , intent(out) :: info
|
|
|
|
|
|
|
|
|
|
logical :: keep
|
|
|
|
|
integer :: it, nr
|
2015-05-02 12:43:28 -03:00
|
|
|
|
real(kind=8) :: dd, ss, ec
|
2015-04-27 18:42:43 -03:00
|
|
|
|
real(kind=8) :: f , df
|
|
|
|
|
real(kind=8) :: dw, err
|
|
|
|
|
|
2015-05-04 11:03:41 -03:00
|
|
|
|
real(kind=8), dimension(5) :: a
|
|
|
|
|
real(kind=8), dimension(4) :: x
|
2018-01-17 11:31:43 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
2018-08-26 23:08:57 -03:00
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::nr_initial_brackets_srmhd_adi()'
|
2021-11-19 12:33:47 -03:00
|
|
|
|
|
2015-04-27 18:42:43 -03:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! calculate temporary variables
|
|
|
|
|
!
|
|
|
|
|
dd = dn * dn
|
|
|
|
|
ss = mb * mb
|
2015-05-02 12:43:28 -03:00
|
|
|
|
ec = en + pmin
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
|
|
|
|
! set the initial upper bracket
|
|
|
|
|
!
|
|
|
|
|
wu = en + pmin
|
|
|
|
|
|
2015-05-02 12:43:28 -03:00
|
|
|
|
! calculate the cubic equation coefficients for the positivity condition
|
2015-05-04 11:03:41 -03:00
|
|
|
|
! coming from the energy equation; the condition, in fact, finds the minimum
|
2015-05-02 12:43:28 -03:00
|
|
|
|
! enthalphy for which the pressure is equal to pmin
|
2015-04-27 18:42:43 -03:00
|
|
|
|
!
|
2015-05-02 12:43:28 -03:00
|
|
|
|
a(3) = 2.5d+00 * bb - ec
|
|
|
|
|
a(2) = 2.0d+00 * (bb - ec) * bb
|
|
|
|
|
a(1) = 0.5d+00 * (((bb - 2.0d+00 * ec) * bb + mm) * bb - ss)
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
2015-05-02 12:43:28 -03:00
|
|
|
|
! solve the cubic equation
|
2015-04-27 18:42:43 -03:00
|
|
|
|
!
|
2015-05-02 12:43:28 -03:00
|
|
|
|
nr = cubic_normalized(a(1:3), x(1:3))
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
|
|
|
|
! if solution was found, use the maximum root as the lower bracket
|
|
|
|
|
!
|
|
|
|
|
if (nr > 0) then
|
|
|
|
|
|
|
|
|
|
wl = x(nr)
|
|
|
|
|
|
2015-05-04 11:03:41 -03:00
|
|
|
|
! calculate the quartic equation coefficients for the positivity condition
|
|
|
|
|
! coming from the pressure equation
|
|
|
|
|
!
|
|
|
|
|
a(5) = 1.0d+00
|
|
|
|
|
a(4) = 2.0d+00 * bb
|
|
|
|
|
a(3) = bb * bb - dd - mm
|
|
|
|
|
a(2) = - 2.0d+00 * (ss + dd * bb)
|
|
|
|
|
a(1) = - (ss + dd * bb) * bb
|
|
|
|
|
|
|
|
|
|
! solve the quartic equation
|
|
|
|
|
!
|
|
|
|
|
nr = quartic(a(1:5), x(1:4))
|
|
|
|
|
|
|
|
|
|
! take the maximum ethalpy from both conditions to guarantee that the pressure
|
|
|
|
|
! obtains from any of those equations is positive
|
|
|
|
|
!
|
|
|
|
|
if (nr > 0) wl = max(wl, x(nr))
|
|
|
|
|
|
2015-04-27 18:42:43 -03:00
|
|
|
|
else ! nr = 0
|
|
|
|
|
|
|
|
|
|
! the root could not be found analytically, so use the iterative solver
|
|
|
|
|
! to find the lower bracket; as the initial guess use the initial upper bracket
|
|
|
|
|
!
|
|
|
|
|
keep = .true.
|
|
|
|
|
it = nrmax
|
|
|
|
|
wl = wu
|
|
|
|
|
do while(keep)
|
2020-08-06 18:31:14 -03:00
|
|
|
|
call nr_pressure_srmhd_adi_1d(mm, bb, mb, ec, wl, f, df)
|
2015-04-27 18:42:43 -03:00
|
|
|
|
dw = f / df
|
|
|
|
|
wl = wl - dw
|
|
|
|
|
err = abs(dw / wl)
|
|
|
|
|
it = it - 1
|
|
|
|
|
keep = (err > tol) .and. it > 0
|
|
|
|
|
end do
|
|
|
|
|
if (it <= 0) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, &
|
|
|
|
|
"Iterative solver failed to find the lower bracket!")
|
|
|
|
|
write(msg,"(a,5(1x,1es24.16e3))") "D, |m|², m.B, |B|², E = ", &
|
|
|
|
|
dn, mm, mb, bb, en
|
|
|
|
|
call print_message(loc, msg)
|
2015-04-27 18:42:43 -03:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
end if ! nr > 0
|
|
|
|
|
|
|
|
|
|
! check if the energy function is negative for the lower limit
|
|
|
|
|
!
|
|
|
|
|
call nr_function_srmhd_adi_1d(mm, bb, mb, en, dn, wl, fl)
|
|
|
|
|
|
2018-01-17 11:31:43 -02:00
|
|
|
|
if (fl <= 0.0d+00) then
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
|
|
|
|
! make sure that the upper limit is larger than the lower one
|
|
|
|
|
!
|
2018-01-17 11:31:43 -02:00
|
|
|
|
if (wu <= wl) wu = 2.0d+00 * wl
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
|
|
|
|
! check if the brackets bound the root region, if not proceed until
|
|
|
|
|
! opposite function signs are found for the brackets
|
|
|
|
|
!
|
2018-01-17 11:31:43 -02:00
|
|
|
|
call nr_function_srmhd_adi_1d(mm, bb, mb, en, dn, wu, fu)
|
|
|
|
|
it = nrmax
|
|
|
|
|
keep = fl * fu > 0.0d+00
|
|
|
|
|
do while (keep)
|
|
|
|
|
it = it - 1
|
|
|
|
|
wl = wu
|
|
|
|
|
fl = fu
|
|
|
|
|
wu = 2.0d+00 * wu
|
|
|
|
|
call nr_function_srmhd_adi_1d(mm, bb, mb, en, dn, wu, fu)
|
|
|
|
|
keep = (fl * fu > 0.0d+00) .and. it > 0
|
|
|
|
|
end do
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
2018-01-17 11:31:43 -02:00
|
|
|
|
! the upper bracket was found, so proceed with determining the root
|
|
|
|
|
!
|
|
|
|
|
if (it > 0 .and. fu >= 0.0d+00) then
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
2018-01-17 11:31:43 -02:00
|
|
|
|
! estimate the enthalpy value close to the root
|
|
|
|
|
!
|
|
|
|
|
wc = wl - fl * (wu - wl) / (fu - fl)
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
2018-01-17 11:41:02 -02:00
|
|
|
|
! we have good brackets and guess, so good to go
|
|
|
|
|
!
|
|
|
|
|
info = .true.
|
|
|
|
|
|
2018-01-17 11:31:43 -02:00
|
|
|
|
else ! the upper brack not found
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Could not find the upper bracket!")
|
|
|
|
|
write(msg,"(a,5(1x,1es24.16e3))") "D, |m|², m.B, |B|², E = ", &
|
|
|
|
|
dn, mm, mb, bb, en
|
|
|
|
|
call print_message(loc, msg)
|
2018-01-17 11:31:43 -02:00
|
|
|
|
info = .false.
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
2018-01-17 11:31:43 -02:00
|
|
|
|
end if
|
2015-04-27 18:42:43 -03:00
|
|
|
|
|
2018-01-17 11:31:43 -02:00
|
|
|
|
else ! the root cannot be found, since it is below the lower bracket
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Positive function for lower bracket!")
|
|
|
|
|
write(msg,"(a,6(1x,1es24.16e3))") "D, |m|², m.B, |B|², E, W = ", &
|
|
|
|
|
dn, mm, mb, bb, en, wl
|
|
|
|
|
call print_message(loc, msg)
|
2015-04-27 18:42:43 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_initial_brackets_srmhd_adi
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! subroutine NR_ITERATE_SRMHD_ADI_1DW:
|
|
|
|
|
! -----------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine finds a root W of equation
|
|
|
|
|
!
|
|
|
|
|
! F(W) = W - P(W) + ½ [(1 + |V|²) |B|² - S² / W²] - E = 0
|
|
|
|
|
!
|
|
|
|
|
! using the Newton-Raphson 1Dw iterative method.
|
2015-02-17 12:35:52 -02:00
|
|
|
|
!
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
|
|
|
|
! bb, bm - input coefficients for |B|² and B.M, respectively;
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! w , vv - input/output coefficients W and |V|²;
|
2015-02-22 13:39:50 -03:00
|
|
|
|
! info - the flag is .true. if the solution was found, otherwise
|
|
|
|
|
! it is .false.;
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! Noble, S. C., Gammie, C. F., McKinney, J. C, Del Zanna, L.,
|
|
|
|
|
! "Primitive Variable Solvers for Conservative General Relativistic
|
|
|
|
|
! Magnetohydrodynamics",
|
|
|
|
|
! The Astrophysical Journal, 2006, vol. 641, pp. 626-637
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
subroutine nr_iterate_srmhd_adi_1dw(mm, bb, mb, en, dn, w, vv, info)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
use helpers, only : print_message
|
2018-01-17 11:10:34 -02:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
implicit none
|
|
|
|
|
|
2015-02-22 13:09:03 -03:00
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical , intent(out) :: info
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
logical :: keep
|
|
|
|
|
integer :: it, cn
|
2015-04-27 18:49:12 -03:00
|
|
|
|
real(kind=8) :: wl, wu, fl, fu
|
|
|
|
|
real(kind=8) :: f , df, dw
|
2015-02-17 11:28:40 -02:00
|
|
|
|
real(kind=8) :: err
|
2018-01-17 11:10:34 -02:00
|
|
|
|
|
2021-11-19 12:33:47 -03:00
|
|
|
|
character(len=80) :: msg
|
|
|
|
|
|
2018-01-17 11:10:34 -02:00
|
|
|
|
character(len=*), parameter :: loc = 'EQUATIONS::nr_iterate_srmhd_adi_1dw()'
|
2021-11-19 12:33:47 -03:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-04-27 18:49:12 -03:00
|
|
|
|
! find the initial brackets and estimate the initial enthalpy
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2015-04-27 18:49:12 -03:00
|
|
|
|
call nr_initial_brackets_srmhd_adi(mm, bb, mb, en, dn &
|
2018-01-17 11:10:34 -02:00
|
|
|
|
, wl, wu, w, fl, fu, info)
|
2015-04-29 10:21:13 -03:00
|
|
|
|
|
2018-01-17 11:10:34 -02:00
|
|
|
|
! continue if brackets found
|
2015-04-29 10:21:13 -03:00
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
if (info) then
|
2015-04-29 10:21:13 -03:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! initialize iteration parameters
|
2015-02-17 12:35:52 -02:00
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
info = .true.
|
|
|
|
|
keep = .true.
|
|
|
|
|
it = nrmax
|
|
|
|
|
cn = nrext
|
2015-02-27 17:08:12 -03:00
|
|
|
|
|
|
|
|
|
! iterate using the Newton-Raphson method in order to find a root w of the
|
|
|
|
|
! function
|
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
do while(keep)
|
2015-02-17 12:35:52 -02:00
|
|
|
|
|
2015-02-17 12:46:22 -02:00
|
|
|
|
! calculate F(W) and dF(W)/dW
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
call nr_function_srmhd_adi_1d(mm, bb, mb, en, dn, w, f, df)
|
2015-02-27 17:08:12 -03:00
|
|
|
|
|
|
|
|
|
! update brackets
|
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
if (f > fl .and. f < 0.0d+00) then
|
|
|
|
|
wl = w
|
|
|
|
|
fl = f
|
|
|
|
|
end if
|
|
|
|
|
if (f < fu .and. f > 0.0d+00) then
|
|
|
|
|
wu = w
|
|
|
|
|
fu = f
|
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2018-01-17 11:10:34 -02:00
|
|
|
|
! calculate the increment dW, update the solution, and estimate the error
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
dw = f / df
|
|
|
|
|
w = w - dw
|
|
|
|
|
err = abs(dw / w)
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-02-27 17:57:29 -03:00
|
|
|
|
! check the convergence, if the convergence is not reached, iterate until
|
|
|
|
|
! the maximum number of iteration is reached
|
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
if (err < tol) then
|
|
|
|
|
keep = cn > 0
|
|
|
|
|
cn = cn - 1
|
|
|
|
|
else
|
|
|
|
|
keep = it > 0
|
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2015-02-27 17:57:29 -03:00
|
|
|
|
! if new W lays out of the brackets, use the bisection method to estimate
|
|
|
|
|
! the new guess
|
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
if (w < wl .or. w > wu) then
|
|
|
|
|
w = 0.5d+00 * (wl + wu)
|
|
|
|
|
end if
|
2015-02-27 17:57:29 -03:00
|
|
|
|
|
2015-02-17 11:28:40 -02:00
|
|
|
|
! decrease the number of remaining iterations
|
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
it = it - 1
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2018-01-17 11:10:34 -02:00
|
|
|
|
end do ! NR iterations
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2018-01-17 11:10:34 -02:00
|
|
|
|
! let know the user if the convergence failed
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
if (err >= tol) then
|
2021-11-19 12:33:47 -03:00
|
|
|
|
call print_message(loc, "Convergence not reached!")
|
|
|
|
|
write(msg,"(a,1x,1es24.16e3)") "Error: ", err
|
|
|
|
|
call print_message(loc, msg)
|
2018-01-17 11:10:34 -02:00
|
|
|
|
end if
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
2018-01-17 11:10:34 -02:00
|
|
|
|
! calculate |V|² from W
|
2015-02-17 11:28:40 -02:00
|
|
|
|
!
|
2018-01-17 11:10:34 -02:00
|
|
|
|
call nr_velocity_srmhd_adi_1d(mm, bb, mb, w, vv)
|
|
|
|
|
|
|
|
|
|
end if ! correct brackets
|
2015-02-17 11:28:40 -02:00
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_iterate_srmhd_adi_1dw
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-20 13:32:47 -02:00
|
|
|
|
! subroutine NR_ITERATE_SRMHD_ADI_2DWV:
|
|
|
|
|
! ------------------------------------
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
! Subroutine finds a root (W, |V|²) of equations
|
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! F(W,|V|²) = W - P + ½ [(1 + |V|²) |B|² - S² / W²] - E = 0
|
2015-02-17 18:15:11 -02:00
|
|
|
|
! G(W,|V|²) = |V|² (|B|² + W)² - S² (|B|² + 2W) / W² - |M|² = 0
|
|
|
|
|
!
|
|
|
|
|
! using the Newton-Raphson 2D iterative method.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
|
|
|
|
! bb, bm - input coefficients for |B|² and B.M, respectively;
|
|
|
|
|
! w , vv - input/output coefficients W and |V|²;
|
2015-02-22 13:39:50 -03:00
|
|
|
|
! info - the flag is .true. if the solution was found, otherwise
|
|
|
|
|
! it is .false.;
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
! References:
|
|
|
|
|
!
|
|
|
|
|
! Noble, S. C., Gammie, C. F., McKinney, J. C, Del Zanna, L.,
|
|
|
|
|
! "Primitive Variable Solvers for Conservative General Relativistic
|
|
|
|
|
! Magnetohydrodynamics",
|
|
|
|
|
! The Astrophysical Journal, 2006, vol. 641, pp. 626-637
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
2015-02-22 13:39:50 -03:00
|
|
|
|
subroutine nr_iterate_srmhd_adi_2dwv(mm, bb, mb, en, dn, w, vv, info)
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
2015-02-22 13:09:03 -03:00
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
2015-02-17 18:15:11 -02:00
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
2015-02-22 13:39:50 -03:00
|
|
|
|
logical , intent(out) :: info
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
logical :: keep
|
2015-02-17 18:15:11 -02:00
|
|
|
|
integer :: it, cn
|
2015-02-27 17:08:12 -03:00
|
|
|
|
real(kind=8) :: wl, wu, fl, fu
|
|
|
|
|
real(kind=8) :: vm, vs, wt, mw, wt2
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: f, dfw, dfv
|
|
|
|
|
real(kind=8) :: g, dgw, dgv
|
2015-02-17 18:15:11 -02:00
|
|
|
|
real(kind=8) :: det, jfw, jfv, jgw, jgv
|
|
|
|
|
real(kind=8) :: dv, dw
|
|
|
|
|
real(kind=8) :: err
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-04-27 18:52:40 -03:00
|
|
|
|
! find the initial brackets and estimate the initial enthalpy
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-04-27 18:52:40 -03:00
|
|
|
|
call nr_initial_brackets_srmhd_adi(mm, bb, mb, en, dn &
|
|
|
|
|
, wl, wu, w, fl, fu, info)
|
2015-02-27 17:08:12 -03:00
|
|
|
|
|
2015-04-29 10:21:13 -03:00
|
|
|
|
! if the brackets could not be found, return the lower bracket as the solution
|
|
|
|
|
!
|
|
|
|
|
if (.not. info) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "WARNING in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_1dw()"
|
|
|
|
|
write(*,"(a,1x)" ) "The solution lays in unphysical regime."
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Using the lower bracket as solution: ", wl
|
2015-04-29 10:21:13 -03:00
|
|
|
|
|
|
|
|
|
! use the lower bracket, since it guarantees the positive pressure
|
|
|
|
|
!
|
|
|
|
|
w = wl
|
|
|
|
|
|
|
|
|
|
! calculate |V|² from W
|
|
|
|
|
!
|
|
|
|
|
call nr_velocity_srmhd_adi_1d(mm, bb, mb, w, vv)
|
|
|
|
|
|
|
|
|
|
info = .true.
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! and the corresponding |V|²
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
call nr_velocity_srmhd_adi_1d(mm, bb, mb, w, vv)
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! initialize iteration parameters
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
info = .true.
|
|
|
|
|
keep = .true.
|
|
|
|
|
it = nrmax
|
|
|
|
|
cn = nrext
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! find root with the help of the Newton-Raphson method
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
do while(keep)
|
|
|
|
|
|
|
|
|
|
! calculate (S/W)², Wt, Wt²
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
mw = (mb / w)**2
|
|
|
|
|
wt = w + bb
|
|
|
|
|
wt2 = wt * wt
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! prepare (1 - |V|²) and sqrt(1 - |V|²)
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
vm = 1.0d+00 - vv
|
|
|
|
|
vs = sqrt(vm)
|
|
|
|
|
|
|
|
|
|
! calculate functions F(W,|V|²) and G(W,|V|²)
|
|
|
|
|
!
|
|
|
|
|
f = w - en - gammaxi * (w * vm - dn * vs) &
|
|
|
|
|
+ 0.5d+00 * ((1.0d+00 + vv) * bb - mw)
|
|
|
|
|
g = vv * wt2 - (wt + w) * mw - mm
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! calculate derivatives dF(W,|V|²)/dW and dF(W,|V|²)/d|V|²
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
2015-02-27 17:08:12 -03:00
|
|
|
|
dfw = 1.0d+00 - gammaxi * vm + mw / w
|
|
|
|
|
dfv = - gammaxi * (0.5d+00 * dn / vs - w) + 0.5d+00 * bb
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! calculate derivatives dG(W,|V|²)/dW and dG(W,|V|²)/d|V|²
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
dgw = 2.0d+00 * wt * (vv + mw / w)
|
2015-02-27 17:08:12 -03:00
|
|
|
|
dgv = wt2
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
|
|
|
|
! invert the Jacobian J = | dF/dW, dF/d|V|² |
|
|
|
|
|
! | dG/dW, dG/d|V|² |
|
|
|
|
|
!
|
|
|
|
|
det = dfw * dgv - dfv * dgw
|
|
|
|
|
|
|
|
|
|
jfw = dgv / det
|
|
|
|
|
jgw = - dfv / det
|
|
|
|
|
jfv = - dgw / det
|
|
|
|
|
jgv = dfw / det
|
|
|
|
|
|
|
|
|
|
! calculate increments dW and d|V|²
|
|
|
|
|
!
|
|
|
|
|
dw = f * jfw + g * jgw
|
|
|
|
|
dv = f * jfv + g * jgv
|
|
|
|
|
|
|
|
|
|
! correct W and |V|²
|
|
|
|
|
!
|
|
|
|
|
w = w - dw
|
|
|
|
|
vv = vv - dv
|
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! check if the new enthalpy and velocity are physical
|
|
|
|
|
!
|
|
|
|
|
if (w < wl) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_2dwv()"
|
|
|
|
|
write(*,"(a,1x,2es24.16e3)") "Enthalpy smaller than the limit: ", w, wl
|
2015-02-27 17:08:12 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (vv < 0.0d+00 .or. vv >= 1.0d+00) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_2dwv()"
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Unphysical speed |v|²: ", vv
|
2015-02-27 17:08:12 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! calculate the error
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
err = max(abs(dw / w), abs(dv))
|
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! check the convergence, if the convergence is not reached, iterate until
|
|
|
|
|
! the maximum number of iteration is reached
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
if (err < tol) then
|
2015-02-27 17:08:12 -03:00
|
|
|
|
keep = cn > 0
|
|
|
|
|
cn = cn - 1
|
|
|
|
|
else
|
|
|
|
|
keep = it > 0
|
2015-02-17 18:15:11 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! decrease the number of remaining iterations
|
|
|
|
|
!
|
|
|
|
|
it = it - 1
|
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
end do ! NR iterations
|
2015-02-17 18:15:11 -02:00
|
|
|
|
|
2015-02-27 17:08:12 -03:00
|
|
|
|
! let know the user if the convergence failed
|
2015-02-17 18:15:11 -02:00
|
|
|
|
!
|
|
|
|
|
if (err >= tol) then
|
2015-02-27 17:08:12 -03:00
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "WARNING in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_2dwv()"
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Convergence not reached: ", err
|
2015-02-17 18:15:11 -02:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-02-20 13:32:47 -02:00
|
|
|
|
end subroutine nr_iterate_srmhd_adi_2dwv
|
2015-02-28 14:22:00 -03:00
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
! subroutine NR_ITERATE_SRMHD_ADI_2DWU:
|
|
|
|
|
! ------------------------------------
|
|
|
|
|
!
|
|
|
|
|
! Subroutine finds a root (W, |u|²) of equations
|
|
|
|
|
!
|
|
|
|
|
! F(W,|u|²) = W - E - P + ½ [(1 + |u|² / (1 + |u|²)) |B|² - S² / W²] = 0
|
|
|
|
|
! G(W,|u|²) = (|B|² + W)² |u|² / (1 + |u|²) - (2W + |B|²) S² / W² - |M|² = 0
|
|
|
|
|
!
|
|
|
|
|
! using the Newton-Raphson 2D iterative method.
|
|
|
|
|
!
|
|
|
|
|
! Arguments:
|
|
|
|
|
!
|
|
|
|
|
! mm, en - input coefficients for |M|² and E, respectively;
|
|
|
|
|
! bb, bm - input coefficients for |B|² and B.M, respectively;
|
|
|
|
|
! w , vv - input/output coefficients W and |v|²;
|
|
|
|
|
! info - the flag is .true. if the solution was found, otherwise
|
|
|
|
|
! it is .false.;
|
|
|
|
|
!
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
subroutine nr_iterate_srmhd_adi_2dwu(mm, bb, mb, en, dn, w, vv, info)
|
|
|
|
|
|
|
|
|
|
! local variables are not implicit by default
|
|
|
|
|
!
|
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
|
|
! input/output arguments
|
|
|
|
|
!
|
|
|
|
|
real(kind=8), intent(in) :: mm, bb, mb, en, dn
|
|
|
|
|
real(kind=8), intent(inout) :: w, vv
|
|
|
|
|
logical , intent(out) :: info
|
|
|
|
|
|
|
|
|
|
! local variables
|
|
|
|
|
!
|
|
|
|
|
logical :: keep
|
|
|
|
|
integer :: it, cn
|
|
|
|
|
real(kind=8) :: wl, wu, fl, fu
|
|
|
|
|
real(kind=8) :: uu, up, gm
|
|
|
|
|
real(kind=8) :: ss, ww, wt, wt2, wd, wp
|
2020-08-06 18:31:14 -03:00
|
|
|
|
real(kind=8) :: f, dfw, dfu
|
|
|
|
|
real(kind=8) :: g, dgw, dgu
|
2015-02-28 14:22:00 -03:00
|
|
|
|
real(kind=8) :: det, jfw, jfu, jgw, jgu
|
|
|
|
|
real(kind=8) :: dw, du
|
|
|
|
|
real(kind=8) :: err
|
|
|
|
|
!
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
2015-04-27 18:55:05 -03:00
|
|
|
|
! find the initial brackets and estimate the initial enthalpy
|
2015-02-28 14:22:00 -03:00
|
|
|
|
!
|
2015-04-27 18:55:05 -03:00
|
|
|
|
call nr_initial_brackets_srmhd_adi(mm, bb, mb, en, dn &
|
|
|
|
|
, wl, wu, w, fl, fu, info)
|
2015-02-28 14:22:00 -03:00
|
|
|
|
|
2015-04-29 10:21:13 -03:00
|
|
|
|
! if the brackets could not be found, return the lower bracket as the solution
|
|
|
|
|
!
|
|
|
|
|
if (.not. info) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "WARNING in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_1dw()"
|
|
|
|
|
write(*,"(a,1x)" ) "The solution lays in unphysical regime."
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Using the lower bracket as solution: ", wl
|
2015-04-29 10:21:13 -03:00
|
|
|
|
|
|
|
|
|
! use the lower bracket, since it guarantees the positive pressure
|
|
|
|
|
!
|
|
|
|
|
w = wl
|
|
|
|
|
|
|
|
|
|
! calculate |V|² from W
|
|
|
|
|
!
|
|
|
|
|
call nr_velocity_srmhd_adi_1d(mm, bb, mb, w, vv)
|
|
|
|
|
|
|
|
|
|
info = .true.
|
|
|
|
|
return
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
|
|
2015-02-28 14:22:00 -03:00
|
|
|
|
! and the corresponding |u|²
|
|
|
|
|
!
|
|
|
|
|
call nr_velocity_srmhd_adi_1d(mm, bb, mb, w, vv)
|
|
|
|
|
uu = vv / (1.0d+00 - vv)
|
|
|
|
|
|
|
|
|
|
! initialize iteration parameters
|
|
|
|
|
!
|
|
|
|
|
info = .true.
|
|
|
|
|
keep = .true.
|
|
|
|
|
it = nrmax
|
|
|
|
|
cn = nrext
|
|
|
|
|
|
|
|
|
|
! find root with the help of the Newton-Raphson method
|
|
|
|
|
!
|
|
|
|
|
do while(keep)
|
|
|
|
|
|
|
|
|
|
! prepare (1 + |u|²) and the Lorentz factor
|
|
|
|
|
!
|
|
|
|
|
up = 1.0d+00 + uu
|
|
|
|
|
gm = sqrt(up)
|
|
|
|
|
|
|
|
|
|
! calculate temporary variables
|
|
|
|
|
!
|
|
|
|
|
ss = mb * mb
|
|
|
|
|
ww = w * w
|
|
|
|
|
wt = w + bb
|
|
|
|
|
wt2 = wt * wt
|
|
|
|
|
wd = w - gm * dn
|
|
|
|
|
wp = wt / up
|
|
|
|
|
|
|
|
|
|
! calculate functions F(W,|u|²) and G(W,|u|²)
|
|
|
|
|
!
|
|
|
|
|
f = w - en - gammaxi * wd / up &
|
|
|
|
|
+ 0.5d+00 * (bb * (1.0d+00 + uu / up) - ss / ww)
|
|
|
|
|
g = wp * wt * uu - (w + wt) * ss / ww - mm
|
|
|
|
|
|
|
|
|
|
! calculate derivatives dF(W,|u|²)/dW and dF(W,|u|²)/d|u|²
|
|
|
|
|
!
|
|
|
|
|
dfw = 1.0d+00 - gammaxi / up + ss / ww / w
|
|
|
|
|
dfu = 0.5d+00 * (gammaxi * (w + wd) + bb) / up**2
|
|
|
|
|
|
|
|
|
|
! calculate derivatives dG(W,|u|²)/dW and dG(W,|u|²)/d|u|²
|
|
|
|
|
!
|
|
|
|
|
dgw = 2.0d+00 * wt * (uu / up + ss / ww / w)
|
|
|
|
|
dgu = wp * wp
|
|
|
|
|
|
|
|
|
|
! invert the Jacobian J = | dF/dW, dF/d|u|² |
|
|
|
|
|
! | dG/dW, dG/d|u|² |
|
|
|
|
|
!
|
|
|
|
|
det = dfw * dgu - dfu * dgw
|
|
|
|
|
|
|
|
|
|
jfw = dgu / det
|
|
|
|
|
jgw = - dfu / det
|
|
|
|
|
jfu = - dgw / det
|
|
|
|
|
jgu = dfw / det
|
|
|
|
|
|
|
|
|
|
! calculate increments dW and d|u|²
|
|
|
|
|
!
|
|
|
|
|
dw = f * jfw + g * jgw
|
|
|
|
|
du = f * jfu + g * jgu
|
|
|
|
|
|
|
|
|
|
! correct W and |u|²
|
|
|
|
|
!
|
|
|
|
|
w = w - dw
|
|
|
|
|
uu = uu - du
|
|
|
|
|
|
|
|
|
|
! check if the new enthalpy and velocity are physical
|
|
|
|
|
!
|
|
|
|
|
if (w < wl) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a,1x,2es24.16e3)") "Enthalpy smaller than the limit: ", w, wl
|
2015-02-28 14:22:00 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (uu < 0.0d+00) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "ERROR in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Unphysical speed |u|²: ", uu
|
2015-02-28 14:22:00 -03:00
|
|
|
|
info = .false.
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! calculate the error
|
|
|
|
|
!
|
|
|
|
|
err = max(abs(dw / w), abs(du))
|
|
|
|
|
|
|
|
|
|
! check the convergence, if the convergence is not reached, iterate until
|
|
|
|
|
! the maximum number of iteration is reached
|
|
|
|
|
!
|
|
|
|
|
if (err < tol) then
|
|
|
|
|
keep = cn > 0
|
|
|
|
|
cn = cn - 1
|
|
|
|
|
else
|
|
|
|
|
keep = it > 0
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
! decrease the number of remaining iterations
|
|
|
|
|
!
|
|
|
|
|
it = it - 1
|
|
|
|
|
|
|
|
|
|
end do ! NR iterations
|
|
|
|
|
|
|
|
|
|
! calculate |v|² from |u|²
|
|
|
|
|
!
|
|
|
|
|
vv = uu / (1.0d+00 + uu)
|
|
|
|
|
|
|
|
|
|
! let know the user if the convergence failed
|
|
|
|
|
!
|
|
|
|
|
if (err >= tol) then
|
|
|
|
|
write(*,*)
|
2018-08-27 19:51:45 -03:00
|
|
|
|
write(*,"(a,1x,a)" ) "WARNING in" &
|
|
|
|
|
, "EQUATIONS::nr_iterate_srmhd_adi_2dwu()"
|
|
|
|
|
write(*,"(a,1x,1es24.16e3)") "Convergence not reached: ", err
|
2015-02-28 14:22:00 -03:00
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
!-------------------------------------------------------------------------------
|
|
|
|
|
!
|
|
|
|
|
end subroutine nr_iterate_srmhd_adi_2dwu
|
2012-07-27 16:18:02 -03:00
|
|
|
|
|
|
|
|
|
!===============================================================================
|
|
|
|
|
!
|
|
|
|
|
end module equations
|