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

Merge branch 'master' into reconnection

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2018-08-30 09:10:58 -03:00
commit 5e27420dcf
9 changed files with 180 additions and 74 deletions

25
src/algebra.F90

@ -29,16 +29,25 @@
!
module algebra
! include external procedures
!
use iso_fortran_env, only : real32, real64, real128
! module variables are not implicit by default
!
implicit none
! maximum real kind
!
integer, parameter :: max_real_kind = max(real32, real64, real128)
! by default everything is private
!
private
! declare public subroutines
!
public :: max_real_kind
public :: quadratic, quadratic_normalized
public :: cubic, cubic_normalized
public :: quartic
@ -1194,17 +1203,17 @@ module algebra
! input/output arguments
!
integer , intent(in) :: n
real(kind=16), dimension(n,n), intent(in) :: m
real(kind=16), dimension(n,n), intent(out) :: r
logical , intent(out) :: f
integer , intent(in) :: n
real(kind=max_real_kind), dimension(n,n), intent(in) :: m
real(kind=max_real_kind), dimension(n,n), intent(out) :: r
logical , intent(out) :: f
! local variables
!
logical :: flag = .true.
integer :: i, j, k, l
real(kind=16) :: t
real(kind=16), dimension(n,2*n) :: g
logical :: flag = .true.
integer :: i, j, k, l
real(kind=max_real_kind) :: t
real(kind=max_real_kind), dimension(n,2*n) :: g
!
!-------------------------------------------------------------------------------
!

62
src/equations.F90

@ -61,26 +61,72 @@ module equations
integer , save :: imi, imc, imf, imm, imp, imb
#endif /* PROFILE */
! the number of independent variables
!
integer(kind=4) , save :: nv = 0
! interfaces for procedure pointers
!
interface
subroutine prim2cons_iface(n, q, u)
import :: nv
integer , intent(in) :: n
real(kind=8), dimension(nv,n), intent(in) :: q
real(kind=8), dimension(nv,n), intent(out) :: u
end subroutine
subroutine cons2prim_iface(n, u, q)
import :: nv
integer , intent(in) :: n
real(kind=8), dimension(nv,n), intent(in) :: u
real(kind=8), dimension(nv,n), intent(out) :: q
end subroutine
subroutine fluxspeed_iface(n, q, u, f, cm, cp)
import :: nv
integer , intent(in) :: n
real(kind=8), dimension(nv,n) , intent(in) :: q, u
real(kind=8), dimension(nv,n) , intent(out) :: f
real(kind=8), dimension(n) , optional, intent(out) :: cm, cp
end subroutine
function maxspeed_iface(qq) result(maxspeed)
use coordinates, only : im, jm, km
import :: nv
real(kind=8), dimension(nv,im,jm,km), intent(in) :: qq
real(kind=8) :: maxspeed
end function
subroutine esystem_roe_iface(x, y, q, c, r, l)
import :: nv
real(kind=8) , intent(in) :: x, y
real(kind=8), dimension(nv) , intent(in) :: q
real(kind=8), dimension(nv) , intent(inout) :: c
real(kind=8), dimension(nv,nv), intent(inout) :: l, r
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
! pointers to the conversion procedures
!
procedure(prim2cons_hd_iso) , pointer, save :: prim2cons => null()
procedure(cons2prim_hd_iso) , pointer, save :: cons2prim => null()
procedure(prim2cons_iface) , pointer, save :: prim2cons => null()
procedure(cons2prim_iface) , pointer, save :: cons2prim => null()
! pointer to the flux procedure
!
procedure(fluxspeed_hd_iso) , pointer, save :: fluxspeed => null()
procedure(fluxspeed_iface) , pointer, save :: fluxspeed => null()
! pointer to the maxspeed procedure
!
procedure(maxspeed_hd_iso) , pointer, save :: maxspeed => null()
procedure(maxspeed_iface) , pointer, save :: maxspeed => null()
! pointer to the Roe eigensystem procedure
!
procedure(esystem_roe_hd_iso), pointer, save :: eigensystem_roe => null()
procedure(esystem_roe_iface), pointer, save :: eigensystem_roe => null()
! pointer to the variable conversion method
!
procedure(nr_iterate_srhd_adi_1dw), pointer, save :: nr_iterate => null()
procedure(nr_iterate_iface) , pointer, save :: nr_iterate => null()
! the system of equations and the equation of state
!
@ -91,10 +137,6 @@ module equations
!
character(len=32), save :: c2p = "1Dw"
! the number of independent variables
!
integer(kind=4) , save :: nv = 0
! direction indices
!
integer(kind=4) , save :: inx = 1, iny = 2, inz = 3

26
src/evolution.F90

@ -47,9 +47,16 @@ module evolution
integer , save :: imi, ima, imt, imu, imf, iui, imv
#endif /* PROFILE */
! interfaces for procedure pointers
!
abstract interface
subroutine evolve_iface()
end subroutine
end interface
! pointer to the temporal integration subroutine
!
procedure(evolve_euler), pointer, save :: evolve => null()
procedure(evolve_iface), pointer, save :: evolve => null()
! evolution parameters
!
@ -2102,11 +2109,9 @@ module evolution
! include external procedures
!
use coordinates , only : im, jm, km
use equations , only : nv, pvars, cvars
#ifdef IBM
use, intrinsic :: ieee_arithmetic
#endif /* IBM */
use coordinates , only : im, jm, km
use equations , only : nv, pvars, cvars
use ieee_arithmetic, only : ieee_is_nan
! include external variables
!
@ -2146,21 +2151,12 @@ module evolution
do j = 1, jm
do i = 1, im
do p = 1, nv
#ifdef IBM
if (ieee_is_nan(pdata%u(p,i,j,k))) then
print *, 'U NaN:', cvars(p), pdata%meta%id, i, j, k
end if
if (ieee_is_nan(pdata%q(p,i,j,k))) then
print *, 'Q NaN:', pvars(p), pdata%meta%id, i, j, k
end if
#else /* IBM */
if (isnan(pdata%u(p,i,j,k))) then
print *, 'U NaN:', cvars(p), pdata%meta%id, i, j, k
end if
if (isnan(pdata%q(p,i,j,k))) then
print *, 'Q NaN:', pvars(p), pdata%meta%id, i, j, k
end if
#endif /* IBM */
end do ! p = 1, nv
end do ! i = 1, im
end do ! j = 1, jm

12
src/gravity.F90

@ -50,9 +50,19 @@ module gravity
!
logical, save :: gravity_enabled = .false.
! interfaces for procedure pointers
!
abstract interface
subroutine gacc_iface(t, dt, x, y, z, acc)
real(kind=8) , intent(in) :: t, dt
real(kind=8) , intent(in) :: x, y, z
real(kind=8), dimension(3), intent(out) :: acc
end subroutine
end interface
! pointer to the gravitational acceleration subroutine
!
procedure(gacc_none), pointer, save :: gravitational_acceleration => null()
procedure(gacc_iface), pointer, save :: gravitational_acceleration => null()
! by default everything is private
!

28
src/integrals.F90

@ -53,9 +53,9 @@ module integrals
! sunit - a file handler to the statistics file;
! iintd - the number of steps between subsequent intervals storing;
!
integer(kind=4), save :: funit = 7
integer(kind=4), save :: sunit = 8
integer(kind=4), save :: runit = 9
integer(kind=4), save :: funit = 11
integer(kind=4), save :: sunit = 12
integer(kind=4), save :: runit = 13
integer(kind=4), save :: iintd = 1
! by default everything is private
@ -143,18 +143,13 @@ module integrals
! create a new integrals file
!
#ifdef GNU
open (newunit = funit, file = fname, form = 'formatted' &
, status = 'replace')
#endif /* GNU */
#ifdef INTEL
open (newunit = funit, file = fname, form = 'formatted' &
, status = 'replace', buffered = 'yes')
#endif /* INTEL */
#ifdef IBM
open (unit = funit, file = fname, form = 'formatted' &
#else /* INTEL */
open (newunit = funit, file = fname, form = 'formatted' &
, status = 'replace')
#endif /* IBM */
#endif /* INTEL */
! write the integral file header
!
@ -169,18 +164,13 @@ module integrals
! create a new statistics file
!
#ifdef GNU
open (newunit = sunit, file = fname, form = 'formatted' &
, status = 'replace')
#endif /* GNU */
#ifdef INTEL
open (newunit = sunit, file = fname, form = 'formatted' &
, status = 'replace', buffered = 'yes')
#endif /* INTEL */
#ifdef IBM
open (unit = sunit, file = fname, form = 'formatted' &
#else /* INTEL */
open (newunit = sunit, file = fname, form = 'formatted' &
, status = 'replace')
#endif /* IBM */
#endif /* INTEL */
! write the integral file header
!

56
src/interpolations.F90

@ -47,13 +47,35 @@ module interpolations
integer , save :: imi, imr, imf, imc
#endif /* PROFILE */
! interfaces for procedure pointers
!
abstract interface
subroutine interfaces_iface(positive, h, q, qi)
use coordinates, only : im , jm , km
logical , intent(in) :: positive
real(kind=8), dimension(NDIMS) , intent(in) :: h
real(kind=8), dimension(im,jm,km) , intent(in) :: q
real(kind=8), dimension(im,jm,km,2,NDIMS), intent(out) :: qi
end subroutine
subroutine reconstruct_iface(n, h, f, fl, fr)
integer , intent(in) :: n
real(kind=8) , intent(in) :: h
real(kind=8), dimension(n), intent(in) :: f
real(kind=8), dimension(n), intent(out) :: fl, fr
end subroutine
function limiter_iface(x, a, b) result(c)
real(kind=8), intent(in) :: x, a, b
real(kind=8) :: c
end function
end interface
! pointers to the reconstruction and limiter procedures
!
procedure(interfaces_tvd) , pointer, save :: interfaces => null()
procedure(reconstruct) , pointer, save :: reconstruct_states => null()
procedure(limiter_zero) , pointer, save :: limiter_tvd => null()
procedure(limiter_zero) , pointer, save :: limiter_prol => null()
procedure(limiter_zero) , pointer, save :: limiter_clip => null()
procedure(interfaces_iface) , pointer, save :: interfaces => null()
procedure(reconstruct_iface) , pointer, save :: reconstruct_states => null()
procedure(limiter_iface) , pointer, save :: limiter_tvd => null()
procedure(limiter_iface) , pointer, save :: limiter_prol => null()
procedure(limiter_iface) , pointer, save :: limiter_clip => null()
! module parameters
!
@ -537,7 +559,7 @@ module interpolations
! include external procedures
!
use algebra , only : invert
use algebra , only : max_real_kind, invert
use constants , only : pi
use iso_fortran_env, only : error_unit
@ -551,14 +573,14 @@ module interpolations
! local variables
!
logical :: flag
integer :: i, j, i1, j1, k1, i2, j2, k2
real(kind=16) :: sig, fc, fx, fy, fz, xl, xr, yl, yr, zl, zr
logical :: flag
integer :: i, j, i1, j1, k1, i2, j2, k2
real(kind=max_real_kind) :: sig, fc, fx, fy, fz, xl, xr, yl, yr, zl, zr
! local arrays for derivatives
!
real(kind=16), dimension(:,:) , allocatable :: cov, inv
real(kind=16), dimension(:,:,:), allocatable :: xgp
real(kind=max_real_kind), dimension(:,:) , allocatable :: cov, inv
real(kind=max_real_kind), dimension(:,:,:), allocatable :: xgp
! local parameters
!
@ -4417,7 +4439,7 @@ module interpolations
! include external procedures
!
use algebra , only : invert
use algebra , only : max_real_kind, invert
use constants , only : pi
use iso_fortran_env, only : error_unit
@ -4431,14 +4453,14 @@ module interpolations
! local variables
!
logical :: flag
integer :: i, j, ip, jp
real(kind=16) :: sig, zl, zr, fc
logical :: flag
integer :: i, j, ip, jp
real(kind=max_real_kind) :: sig, zl, zr, fc
! local arrays for derivatives
!
real(kind=16), dimension(:,:), allocatable :: cov, agp
real(kind=16), dimension(:) , allocatable :: xgp
real(kind=max_real_kind), dimension(:,:), allocatable :: cov, agp
real(kind=max_real_kind), dimension(:) , allocatable :: xgp
! local parameters
!

11
src/problems.F90

@ -47,9 +47,18 @@ module problems
integer, save :: imi, imu
#endif /* PROFILE */
! interfaces for procedure pointers
!
abstract interface
subroutine setup_problem_iface(pdata)
use blocks, only : block_data
type(block_data), pointer, intent(inout) :: pdata
end subroutine
end interface
! pointer to the problem setup subroutine
!
procedure(setup_problem_blast), pointer, save :: setup_problem => null()
procedure(setup_problem_iface), pointer, save :: setup_problem => null()
! by default everything is private
!

22
src/schemes.F90

@ -53,13 +53,31 @@ module schemes
!
logical , save :: states_4vec = .false.
! interfaces for procedure pointers
!
abstract interface
subroutine update_flux_iface(dx, q, f)
use coordinates , only : im, jm, km
use equations , only : nv
real(kind=8), dimension(NDIMS) , intent(in) :: dx
real(kind=8), dimension( nv,im,jm,km), intent(in) :: q
real(kind=8), dimension(NDIMS,nv,im,jm,km), intent(out) :: f
end subroutine
subroutine riemann_iface(n, ql, qr, f)
use equations, only : nv
integer , intent(in) :: n
real(kind=8), dimension(nv,n), intent(inout) :: ql, qr
real(kind=8), dimension(nv,n), intent(out) :: f
end subroutine
end interface
! pointer to the flux update procedure
!
procedure(update_flux_hd_iso), pointer, save :: update_flux => null()
procedure(update_flux_iface), pointer, save :: update_flux => null()
! pointer to the Riemann solver
!
procedure(riemann_hd_iso_hll), pointer, save :: riemann => null()
procedure(riemann_iface) , pointer, save :: riemann => null()
! by default everything is private
!

12
src/shapes.F90

@ -47,9 +47,19 @@ module shapes
integer, save :: imi, imu
#endif /* PROFILE */
! interfaces for procedure pointers
!
abstract interface
subroutine update_shapes_iface(pdata, time, dt)
use blocks, only : block_data
type(block_data), pointer, intent(inout) :: pdata
real(kind=8) , intent(in) :: time, dt
end subroutine
end interface
! pointer to the shape update subroutine
!
procedure(update_shapes_none), pointer, save :: update_shapes => null()
procedure(update_shapes_iface), pointer, save :: update_shapes => null()
! by default everything is private
!