diff --git a/src/driver.F90 b/src/driver.F90 index c8ce7e0..0740112 100644 --- a/src/driver.F90 +++ b/src/driver.F90 @@ -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) diff --git a/src/gravity.F90 b/src/gravity.F90 new file mode 100644 index 0000000..0f84563 --- /dev/null +++ b/src/gravity.F90 @@ -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 +!! +!! 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 . +!! +!!****************************************************************************** +!! +!! 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 diff --git a/src/makefile b/src/makefile index fb1e425..708f2c2 100644 --- a/src/makefile +++ b/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 \