!!****************************************************************************** !! !! 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-2024 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 implicit none ! flag indicating if the gravitational source term is enabled ! 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_iface), pointer, save :: gravitational_acceleration => null() private public :: initialize_gravity, finalize_gravity public :: gravitational_acceleration public :: gravity_enabled !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! contains ! !=============================================================================== !! !!*** PUBLIC SUBROUTINES ***************************************************** !! !=============================================================================== ! !=============================================================================== ! ! subroutine INITIALIZE_GRAVITY: ! ----------------------------- ! ! Subroutine initializes module GRAVITY. ! ! Arguments: ! ! verbose - a logical flag turning the information printing; ! status - an integer flag for error return value; ! !=============================================================================== ! subroutine initialize_gravity(verbose, status) use parameters, only : get_parameter implicit none logical, intent(in) :: verbose integer, intent(out) :: status character(len=64) :: problem_name = "none" !------------------------------------------------------------------------------- ! status = 0 ! get the problem name ! call get_parameter("problem", problem_name) ! select the shape update subroutine depending on the problem ! select case(trim(problem_name)) case("rt", "rayleightaylor", "rayleigh-taylor") gravitational_acceleration => gacc_rayleigh_taylor gravity_enabled = .true. case default end select !------------------------------------------------------------------------------- ! end subroutine initialize_gravity ! !=============================================================================== ! ! subroutine FINALIZE_GRAVITY: ! --------------------------- ! ! Subroutine releases memory used by the module. ! ! Arguments: ! ! status - an integer flag for error return value; ! !=============================================================================== ! subroutine finalize_gravity(status) implicit none integer, intent(out) :: status !------------------------------------------------------------------------------- ! status = 0 nullify(gravitational_acceleration) !------------------------------------------------------------------------------- ! end subroutine finalize_gravity ! !=============================================================================== !! !!*** PRIVATE SUBROUTINES **************************************************** !! !=============================================================================== ! !=============================================================================== ! ! subroutine GACC_RAYLEIGH_TAYLOR: ! ------------------------------- ! ! Subroutine returns the gravitational acceleration for the Rayleigh-Taylor ! instability problem. ! ! Arguments: ! ! t, dt - time and the time increment; ! x, y, z - rectangular coordinates; ! gacc - vector of the gravitational acceleration; ! !=============================================================================== ! subroutine gacc_rayleigh_taylor(t, dt, x, y, z, gacc) use parameters, only : get_parameter implicit none real(kind=8) , intent(in) :: t, dt real(kind=8) , intent(in) :: x, y, z real(kind=8), dimension(3), intent(out) :: gacc logical , save :: first = .true. real(kind=8), save :: gacc_const = -1.0d+00 !------------------------------------------------------------------------------- ! ! read problem parameters during the first execution ! if (first) then call get_parameter("gacc", gacc_const) first = .false. end if ! calculate gravitational acceleration components ! gacc(1) = 0.0d+00 gacc(2) = gacc_const gacc(3) = 0.0d+00 !------------------------------------------------------------------------------- ! end subroutine gacc_rayleigh_taylor !=============================================================================== ! end module gravity