gravity_base.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: gravity_base.f90                                                  #
!#                                                                           #
!# Copyright (C) 2014-2019                                                   #
!# Björn Sperling   <sperling@astrophysik.uni-kiel.de>                       #
!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de>                       #
!# Jannes Klee      <jklee@astrophysik.uni-kiel.de>                          #
!#                                                                           #
!# 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 2 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, GOOD TITLE or        #
!# NON INFRINGEMENT.  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, write to the Free Software               #
!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.                 #
!#                                                                           #
!#############################################################################
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
MODULE gravity_base_mod
  USE logging_base_mod
  USE mesh_base_mod
  USE physics_base_mod
  USE fluxes_base_mod
  USE boundary_base_mod
  USE marray_base_mod
  USE marray_compound_mod
  USE common_dict
  IMPLICIT NONE
  !--------------------------------------------------------------------------!
  PRIVATE
  TYPE, ABSTRACT, EXTENDS(logging_base) :: gravity_base
    CLASS(logging_base), ALLOCATABLE   :: gravitytype
    CLASS(gravity_base), POINTER       :: next => null() 
    CLASS(marray_base), ALLOCATABLE    :: accel
    REAL, DIMENSION(:,:,:,:), POINTER  :: pot
  CONTAINS
    PROCEDURE :: initgravity
    PROCEDURE :: setoutput
    procedure(updategravity_single), DEFERRED :: updategravity_single
    procedure(calcdiskheight_single), DEFERRED :: calcdiskheight_single
    PROCEDURE :: getgravitypointer
    PROCEDURE :: finalize_base
    procedure(finalize), DEFERRED :: finalize
  END TYPE gravity_base

  abstract INTERFACE
    SUBROUTINE updategravity_single(this,Mesh,Physics,Fluxes,pvar,time,dt)
      IMPORT gravity_base, mesh_base, physics_base, fluxes_base, marray_compound
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(gravity_base), INTENT(INOUT) :: this
      CLASS(mesh_base),    INTENT(IN)    :: Mesh
      CLASS(physics_base), INTENT(IN)    :: Physics
      CLASS(fluxes_base),  INTENT(IN)    :: Fluxes
      REAL,                INTENT(IN)    :: time,dt
      CLASS(marray_compound), INTENT(INOUT) :: pvar
    END SUBROUTINE
    SUBROUTINE calcdiskheight_single(this,Mesh,Physics,pvar,bccsound,h_ext,height)
      IMPORT gravity_base, mesh_base, physics_base, marray_compound, marray_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(gravity_base), INTENT(INOUT) :: this
      CLASS(mesh_base),    INTENT(IN)    :: Mesh
      CLASS(physics_base), INTENT(IN)    :: Physics
      CLASS(marray_compound), INTENT(INOUT) :: pvar
      TYPE(marray_base),      INTENT(INOUT) :: bccsound,h_ext,height
    END SUBROUTINE
    SUBROUTINE finalize(this)
      IMPORT gravity_base
      IMPLICIT NONE
      CLASS(gravity_base), INTENT(INOUT) :: this
    END SUBROUTINE
  END INTERFACE
  ! flags for source terms
  INTEGER, PARAMETER :: pointmass        = 1
  INTEGER, PARAMETER :: pointmass_binary = 2
!  INTEGER, PARAMETER :: MONOPOL          = 3
!  INTEGER, PARAMETER :: MULTIGRID        = 4
  INTEGER, PARAMETER :: spectral         = 5
!  INTEGER, PARAMETER :: POTENTIAL        = 6
  INTEGER, PARAMETER :: sboxspectral     = 7
  !--------------------------------------------------------------------------!
  PUBLIC :: &
       ! types
       gravity_base, &
       ! constants
       pointmass, pointmass_binary, &
       spectral, sboxspectral
  !--------------------------------------------------------------------------!

CONTAINS

  SUBROUTINE initgravity(this,Mesh,Physics,gravity_name,config,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(gravity_base),  INTENT(INOUT) :: this
    CLASS(mesh_base),     INTENT(IN)    :: Mesh
    CLASS(physics_base),  INTENT(IN)    :: Physics
    CHARACTER(LEN=*),     INTENT(IN)    :: gravity_name
    TYPE(Dict_TYP),POINTER              :: config,IO
    !------------------------------------------------------------------------!
    INTEGER :: gtype
    !------------------------------------------------------------------------!
    ! basic initialization of gravity module
    CALL getattr(config, "gtype", gtype)
    ! allocate memory for new gravity term
    CALL this%InitLogging(gtype,gravity_name)
    ALLOCATE(this%accel)
    this%accel = marray_base(physics%VDIM)
    ! reset acceleration
    this%accel%data1d(:) = 0.0
    CALL this%Info(" GRAVITY--> gravity term:      " // this%GetName())
  END SUBROUTINE initgravity

  SUBROUTINE setoutput(this,Mesh,Physics,config,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(gravity_base), INTENT(INOUT) :: this
    CLASS(mesh_base),    INTENT(IN)    :: Mesh
    CLASS(physics_base), INTENT(IN)    :: Physics
    TYPE(Dict_TYP),      POINTER       :: config,IO
    !------------------------------------------------------------------------!
    CHARACTER(LEN=1) :: xyz(3) = (/"x","y","z"/)
    INTEGER          :: valwrite,k
    !------------------------------------------------------------------------!
    CALL getattr(config, "output/accel", valwrite, 1)
    IF (valwrite .EQ. 1) THEN
       DO k=1,SIZE(this%accel%data4d,4)
          CALL setattr(io, ("accel_" // xyz(k)),&
             this%accel%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,k))
       END DO
    END IF

    CALL getattr(config, "output/potential", valwrite, 1)
    IF (valwrite .EQ. 1) &
       CALL setattr(io, "potential",&
         this%pot(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,1))

  END SUBROUTINE setoutput

  FUNCTION getgravitypointer(list,stype) RESULT(gp)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(gravity_base), TARGET  :: list
    INTEGER, INTENT(IN)          :: stype
    CLASS(gravity_base), POINTER :: gp
    !------------------------------------------------------------------------!
    gp => list
    DO
       IF (ASSOCIATED(gp).EQV..false.) EXIT
!CDIR IEXPAND
       IF (gp%GetType().EQ.stype) RETURN
       gp => gp%next
    END DO
  END FUNCTION getgravitypointer

  SUBROUTINE finalize_base(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(gravity_base) :: this
    !------------------------------------------------------------------------!
    ! nothing intializaed
    CALL this%accel%Destroy()
    DEALLOCATE(this%accel)
  END SUBROUTINE finalize_base

END MODULE gravity_base_mod