gravity_base.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: gravity_base.f90 #
5!# #
6!# Copyright (C) 2014-2024 #
7!# Björn Sperling <sperling@astrophysik.uni-kiel.de> #
8!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
9!# Jannes Klee <jklee@astrophysik.uni-kiel.de> #
10!# #
11!# This program is free software; you can redistribute it and/or modify #
12!# it under the terms of the GNU General Public License as published by #
13!# the Free Software Foundation; either version 2 of the License, or (at #
14!# your option) any later version. #
15!# #
16!# This program is distributed in the hope that it will be useful, but #
17!# WITHOUT ANY WARRANTY; without even the implied warranty of #
18!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
19!# NON INFRINGEMENT. See the GNU General Public License for more #
20!# details. #
21!# #
22!# You should have received a copy of the GNU General Public License #
23!# along with this program; if not, write to the Free Software #
24!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
25!# #
26!#############################################################################
31!----------------------------------------------------------------------------!
36!----------------------------------------------------------------------------!
45!----------------------------------------------------------------------------!
54 USE common_dict
55 IMPLICIT NONE
56 !--------------------------------------------------------------------------!
57 PRIVATE
58 TYPE, ABSTRACT, EXTENDS(logging_base) :: gravity_base
60 CLASS(logging_base), ALLOCATABLE :: gravitytype
61 CLASS(gravity_base), POINTER :: next => null()
62 CLASS(marray_base), ALLOCATABLE :: accel, & !< acceleration
63 pot
64 CONTAINS
65 PROCEDURE :: initgravity
66 procedure(setoutput), DEFERRED :: setoutput
67 procedure(updategravity_single), DEFERRED :: updategravity_single
68 procedure(calcdiskheight_single), DEFERRED :: calcdiskheight_single
69 PROCEDURE :: getgravitypointer
70 PROCEDURE :: finalize_base
71 END TYPE gravity_base
72
73 abstract INTERFACE
74 SUBROUTINE setoutput(this,Mesh,Physics,config,IO)
76 IMPLICIT NONE
77 !------------------------------------------------------------------------!
78 CLASS(gravity_base), INTENT(INOUT) :: this
79 CLASS(mesh_base), INTENT(IN) :: Mesh
80 CLASS(physics_base), INTENT(IN) :: Physics
81 TYPE(dict_typ), POINTER :: config,IO
82 END SUBROUTINE
83 SUBROUTINE updategravity_single(this,Mesh,Physics,Fluxes,pvar,time,dt)
85 IMPLICIT NONE
86 !------------------------------------------------------------------------!
87 CLASS(gravity_base), INTENT(INOUT) :: this
88 CLASS(mesh_base), INTENT(IN) :: Mesh
89 CLASS(physics_base), INTENT(IN) :: Physics
90 CLASS(fluxes_base), INTENT(IN) :: Fluxes
91 REAL, INTENT(IN) :: time,dt
92 CLASS(marray_compound), INTENT(INOUT) :: pvar
93 END SUBROUTINE
94 SUBROUTINE calcdiskheight_single(this,Mesh,Physics,pvar,bccsound,h_ext,height)
96 IMPLICIT NONE
97 !------------------------------------------------------------------------!
98 CLASS(gravity_base), INTENT(INOUT) :: this
99 CLASS(mesh_base), INTENT(IN) :: Mesh
100 CLASS(physics_base), INTENT(IN) :: Physics
101 CLASS(marray_compound), INTENT(INOUT) :: pvar
102 TYPE(marray_base), INTENT(INOUT) :: bccsound,h_ext,height
103 END SUBROUTINE
104 END INTERFACE
105 ! flags for source terms
106 INTEGER, PARAMETER :: pointmass = 1
107 INTEGER, PARAMETER :: pointmass_binary = 2
108! INTEGER, PARAMETER :: MONOPOL = 3
109! INTEGER, PARAMETER :: MULTIGRID = 4
110 INTEGER, PARAMETER :: spectral = 5
111! INTEGER, PARAMETER :: POTENTIAL = 6
112 INTEGER, PARAMETER :: sboxspectral = 7
113 !--------------------------------------------------------------------------!
114 PUBLIC :: &
115 ! types
116 gravity_base, &
117 ! constants
120 !--------------------------------------------------------------------------!
121
122CONTAINS
123
124 SUBROUTINE initgravity(this,Mesh,Physics,gravity_name,config,IO)
125 IMPLICIT NONE
126 !------------------------------------------------------------------------!
127 CLASS(gravity_base), INTENT(INOUT) :: this
128 CLASS(mesh_base), INTENT(IN) :: Mesh
129 CLASS(physics_base), INTENT(IN) :: Physics
130 CHARACTER(LEN=*), INTENT(IN) :: gravity_name
131 TYPE(dict_typ),POINTER :: config,IO
132 !------------------------------------------------------------------------!
133 CHARACTER(LEN=1) :: xyz(3) = (/"x","y","z"/)
134 INTEGER :: gtype,k,valwrite
135 !------------------------------------------------------------------------!
136 ! basic initialization of gravity module
137 CALL getattr(config, "gtype", gtype)
138 ! allocate memory for new gravity term
139 CALL this%InitLogging(gtype,gravity_name)
140 ALLOCATE(this%accel)
141 this%accel = marray_base(physics%VDIM)
142 ! reset acceleration
143 this%accel%data1d(:) = 0.0
144 ! check whether gravitational acceleration of a particular gravity
145 ! module should be written into the data file
146 CALL getattr(config, "output/accel", valwrite, 0)
147 IF (valwrite .EQ. 1) THEN
148 DO k=1,SIZE(this%accel%data4d,4)
149 CALL setattr(io, ("accel_" // xyz(k)),&
150 this%accel%data4d(mesh%IMIN:mesh%IMAX,mesh%JMIN:mesh%JMAX,mesh%KMIN:mesh%KMAX,k))
151 END DO
152 END IF
153 CALL this%Info(" GRAVITY--> gravity term: " // this%GetName())
154 END SUBROUTINE initgravity
155
156 FUNCTION getgravitypointer(list,stype) RESULT(gp)
157 IMPLICIT NONE
158 !------------------------------------------------------------------------!
159 CLASS(gravity_base), TARGET :: list
160 INTEGER, INTENT(IN) :: stype
161 CLASS(gravity_base), POINTER :: gp
162 !------------------------------------------------------------------------!
163 gp => list
164 DO
165 IF (ASSOCIATED(gp).EQV..false.) EXIT
166!CDIR IEXPAND
167 IF (gp%GetType().EQ.stype) RETURN
168 gp => gp%next
169 END DO
170 END FUNCTION getgravitypointer
171
172 SUBROUTINE finalize_base(this)
173 IMPLICIT NONE
174 !------------------------------------------------------------------------!
175 CLASS(gravity_base), INTENT(INOUT) :: this
176 !------------------------------------------------------------------------!
177 IF (ALLOCATED(this%accel)) DEALLOCATE(this%accel)
178 END SUBROUTINE finalize_base
179
180END MODULE gravity_base_mod
subroutine finalize_base(this)
Dictionary for generic data types.
Definition: common_dict.f90:61
base module for numerical flux functions
Definition: fluxes_base.f90:39
generic gravity terms module providing functionaly common to all gravity terms
integer, parameter, public spectral
integer, parameter, public pointmass_binary
class(gravity_base) function, pointer getgravitypointer(list, stype)
integer, parameter, public sboxspectral
subroutine initgravity(this, Mesh, Physics, gravity_name, config, IO)
integer, parameter, public pointmass
Basic fosite module.
base class for mesh arrays
Definition: marray_base.f90:36
derived class for compound of mesh arrays
basic mesh module
Definition: mesh_base.f90:72
subroutine setoutput(this, config, IO)
Setup mesh fields for i/o.
Definition: mesh_base.f90:828
Basic physics module.
common data structure
basic mesh array class
Definition: marray_base.f90:69
mesh data structure
Definition: mesh_base.f90:122