GRAVITY: Add new module to handle gravitational forces.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
5c4248581f
commit
e00a70b477
@ -43,6 +43,7 @@ program amun
|
||||
use evolution , only : initialize_evolution, finalize_evolution
|
||||
use evolution , only : advance, new_time_step
|
||||
use evolution , only : step, time, dt
|
||||
use gravity , only : initialize_gravity, finalize_gravity
|
||||
use integrals , only : initialize_integrals, finalize_integrals
|
||||
use integrals , only : store_integrals
|
||||
use interpolations, only : initialize_interpolations, finalize_interpolations
|
||||
@ -416,6 +417,10 @@ program amun
|
||||
write (*,"(1x,a)" ) "Source terms:"
|
||||
end if
|
||||
|
||||
! initialize module GRAVITY
|
||||
!
|
||||
call initialize_gravity(master, iret)
|
||||
|
||||
! initialize module SOURCES
|
||||
!
|
||||
call initialize_sources(master, iret)
|
||||
@ -696,6 +701,10 @@ program amun
|
||||
!
|
||||
call finalize_sources(iret)
|
||||
|
||||
! finalize module GRAVITY
|
||||
!
|
||||
call finalize_gravity(iret)
|
||||
|
||||
! finalize module SHAPES
|
||||
!
|
||||
call finalize_shapes(iret)
|
||||
|
266
src/gravity.F90
Normal file
266
src/gravity.F90
Normal file
@ -0,0 +1,266 @@
|
||||
!!******************************************************************************
|
||||
!!
|
||||
!! This file is part of the AMUN source code, a program to perform
|
||||
!! Newtonian or relativistic magnetohydrodynamical simulations on uniform or
|
||||
!! adaptive mesh.
|
||||
!!
|
||||
!! Copyright (C) 2008-2017 Grzegorz Kowal <grzegorz@amuncode.org>
|
||||
!!
|
||||
!! 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: GRAVITY
|
||||
!!
|
||||
!! This modules handles the calculation of gravitational acceleration, static
|
||||
!! or time dependent.
|
||||
!!
|
||||
!!******************************************************************************
|
||||
!
|
||||
module gravity
|
||||
|
||||
#ifdef PROFILE
|
||||
! include external procedures
|
||||
!
|
||||
use timers, only : set_timer, start_timer, stop_timer
|
||||
#endif /* PROFILE */
|
||||
|
||||
! module variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
#ifdef PROFILE
|
||||
! timer indices
|
||||
!
|
||||
integer, save :: imi, imc
|
||||
#endif /* PROFILE */
|
||||
|
||||
! pointer to the gravitational acceleration subroutine
|
||||
!
|
||||
procedure(gacc_none), pointer, save :: gravitational_acceleration => null()
|
||||
|
||||
! by default everything is private
|
||||
!
|
||||
private
|
||||
|
||||
! declare public subroutines
|
||||
!
|
||||
public :: initialize_gravity, finalize_gravity
|
||||
public :: gravitational_acceleration
|
||||
|
||||
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
!
|
||||
contains
|
||||
!
|
||||
!===============================================================================
|
||||
!!
|
||||
!!*** PUBLIC SUBROUTINES *****************************************************
|
||||
!!
|
||||
!===============================================================================
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine INITIALIZE_GRAVITY:
|
||||
! -----------------------------
|
||||
!
|
||||
! Subroutine initializes module GRAVITY.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! verbose - a logical flag turning the information printing;
|
||||
! iret - an integer flag for error return value;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine initialize_gravity(verbose, iret)
|
||||
|
||||
! include external procedures and variables
|
||||
!
|
||||
use parameters , only : get_parameter_string
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
!
|
||||
logical, intent(in) :: verbose
|
||||
integer, intent(inout) :: iret
|
||||
|
||||
! local variables
|
||||
!
|
||||
character(len=64) :: problem_name = "none"
|
||||
character(len=64) :: enable_gravity = "off"
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
#ifdef PROFILE
|
||||
! set timer descriptions
|
||||
!
|
||||
call set_timer('gravity:: initialize' , imi)
|
||||
call set_timer('gravity:: acceleration', imc)
|
||||
|
||||
! start accounting time for module initialization/finalization
|
||||
!
|
||||
call start_timer(imi)
|
||||
#endif /* PROFILE */
|
||||
|
||||
! get the problem name
|
||||
!
|
||||
call get_parameter_string("problem" , problem_name )
|
||||
call get_parameter_string("enable_gravity", enable_gravity)
|
||||
|
||||
! set the correct procedure pointer if gravity are enabled
|
||||
!
|
||||
select case(trim(enable_gravity))
|
||||
case ("on", "ON", "t", "T", "y", "Y", "true", "TRUE", "yes", "YES")
|
||||
|
||||
! select the shape update subroutine depending on the problem
|
||||
!
|
||||
select case(trim(problem_name))
|
||||
|
||||
! no shape update
|
||||
!
|
||||
case default
|
||||
gravitational_acceleration => gacc_none
|
||||
|
||||
end select
|
||||
|
||||
|
||||
! print information about the Riemann solver
|
||||
!
|
||||
if (verbose) then
|
||||
|
||||
write (*,"(4x,a,1x,a)") "gravity =", trim(enable_gravity)
|
||||
|
||||
end if
|
||||
|
||||
case default
|
||||
|
||||
! by default the gravity is turned off, so reset the procedure pointer
|
||||
!
|
||||
gravitational_acceleration => gacc_none
|
||||
|
||||
end select
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop accounting time for module initialization/finalization
|
||||
!
|
||||
call stop_timer(imi)
|
||||
#endif /* PROFILE */
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine initialize_gravity
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine FINALIZE_GRAVITY:
|
||||
! ---------------------------
|
||||
!
|
||||
! Subroutine releases memory used by the module.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! iret - an integer flag for error return value;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine finalize_gravity(iret)
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
!
|
||||
integer, intent(inout) :: iret
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
#ifdef PROFILE
|
||||
! start accounting time for module initialization/finalization
|
||||
!
|
||||
call start_timer(imi)
|
||||
#endif /* PROFILE */
|
||||
|
||||
! nullify procedure pointers
|
||||
!
|
||||
nullify(gravitational_acceleration)
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop accounting time for module initialization/finalization
|
||||
!
|
||||
call stop_timer(imi)
|
||||
#endif /* PROFILE */
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine finalize_gravity
|
||||
!
|
||||
!===============================================================================
|
||||
!!
|
||||
!!*** PRIVATE SUBROUTINES ****************************************************
|
||||
!!
|
||||
!===============================================================================
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine GACC_NONE:
|
||||
! --------------------
|
||||
!
|
||||
! Subroutine does nothing, but it is required to define the interface for
|
||||
! other specific gracitational acceleration subroutines.
|
||||
!
|
||||
! Arguments:
|
||||
!
|
||||
! time - time at the moment of update;
|
||||
! dt - time step since the last update;
|
||||
! x, y, z - rectangular coordinates;
|
||||
! gacc - vector of the gravitational acceleration;
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
subroutine gacc_none(time, dt, x, y, z, gacc)
|
||||
|
||||
! local variables are not implicit by default
|
||||
!
|
||||
implicit none
|
||||
|
||||
! subroutine arguments
|
||||
!
|
||||
real(kind=8) , intent(in) :: time, dt, x, y, z
|
||||
real(kind=8), dimension(3), intent(out) :: gacc
|
||||
!
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
#ifdef PROFILE
|
||||
! start accounting time for the gravitational acceleration calculation
|
||||
!
|
||||
call start_timer(imc)
|
||||
#endif /* PROFILE */
|
||||
|
||||
#ifdef PROFILE
|
||||
! stop accounting time for the gravitational acceleration calculation
|
||||
!
|
||||
call stop_timer(imc)
|
||||
#endif /* PROFILE */
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine gacc_none
|
||||
|
||||
!===============================================================================
|
||||
!
|
||||
end module gravity
|
16
src/makefile
16
src/makefile
@ -83,11 +83,12 @@ default: $(name).x
|
||||
|
||||
sources = algebra.F90 blocks.F90 boundaries.F90 constants.F90 coordinates.F90 \
|
||||
domains.F90 driver.F90 equations.F90 error.F90 evolution.F90 \
|
||||
integrals.F90 interpolations.F90 io.F90 mesh.F90 mpitools.F90 \
|
||||
operators.F90 parameters.F90 problems.F90 random.F90 refinement.F90 \
|
||||
schemes.F90 shapes.F90 sources.F90 timers.F90 utils.F90
|
||||
gravity.F90 integrals.F90 interpolations.F90 io.F90 mesh.F90 \
|
||||
mpitools.F90 operators.F90 parameters.F90 problems.F90 random.F90 \
|
||||
refinement.F90 schemes.F90 shapes.F90 sources.F90 timers.F90 \
|
||||
utils.F90
|
||||
objects = algebra.o blocks.o boundaries.o constants.o coordinates.o domains.o \
|
||||
driver.o equations.o error.o evolution.o integrals.o \
|
||||
driver.o equations.o error.o evolution.o gravity.o integrals.o \
|
||||
interpolations.o io.o mesh.o mpitools.o operators.o parameters.o \
|
||||
problems.o random.o refinement.o schemes.o shapes.o sources.o \
|
||||
timers.o utils.o
|
||||
@ -127,15 +128,16 @@ boundaries.o : boundaries.F90 blocks.o coordinates.o equations.o error.o \
|
||||
constants.o : constants.F90
|
||||
coordinates.o : coordinates.F90 parameters.o
|
||||
driver.o : driver.F90 blocks.o coordinates.o equations.o evolution.o \
|
||||
integrals.o interpolations.o io.o mesh.o mpitools.o \
|
||||
operators.o parameters.o problems.o random.o refinement.o \
|
||||
schemes.o shapes.o sources.o
|
||||
gravity.o integrals.o interpolations.o io.o mesh.o \
|
||||
mpitools.o operators.o parameters.o problems.o random.o \
|
||||
refinement.o schemes.o shapes.o sources.o
|
||||
equations.o : equations.F90 algebra.o coordinates.o parameters.o timers.o
|
||||
error.o : error.F90
|
||||
evolution.o : evolution.F90 blocks.o boundaries.o coordinates.o \
|
||||
equations.o mesh.o mpitools.o parameters.o schemes.o \
|
||||
shapes.o sources.o
|
||||
domains.o : domains.F90 blocks.o boundaries.o coordinates.o parameters.o
|
||||
gravity.o : gravity.F90 parameters.o timers.o
|
||||
integrals.o : integrals.F90 blocks.o coordinates.o equations.o error.o \
|
||||
evolution.o mpitools.o parameters.o timers.o
|
||||
interpolations.o : interpolations.F90 algebra.o blocks.o coordinates.o error.o \
|
||||
|
Loading…
x
Reference in New Issue
Block a user