amun-code/sources/gravity.F90

!!******************************************************************************
!!
!!  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 <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

  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