physics_base.f90
Go to the documentation of this file.
1!#############################################################################
2!# #
3!# fosite - 3D hydrodynamical simulation program #
4!# module: physics_base.f90 #
5!# #
6!# Copyright (C) 2007 - 2018 #
7!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de> #
8!# Björn Sperling <sperling@astrophysik.uni-kiel.de> #
9!# Manuel Jung <mjung@astrophysik.uni-kiel.de> #
10!# Jannes Klee <jklee@astrophysik.uni-kiel.de> #
11!# #
12!# This program is free software; you can redistribute it and/or modify #
13!# it under the terms of the GNU General Public License as published by #
14!# the Free Software Foundation; either version 2 of the License, or (at #
15!# your option) any later version. #
16!# #
17!# This program is distributed in the hope that it will be useful, but #
18!# WITHOUT ANY WARRANTY; without even the implied warranty of #
19!# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE, GOOD TITLE or #
20!# NON INFRINGEMENT. See the GNU General Public License for more #
21!# details. #
22!# #
23!# You should have received a copy of the GNU General Public License #
24!# along with this program; if not, write to the Free Software #
25!# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. #
26!# #
27!#############################################################################
32!----------------------------------------------------------------------------!
43!----------------------------------------------------------------------------!
54!----------------------------------------------------------------------------!
61 USE common_dict
62 IMPLICIT NONE
63 !--------------------------------------------------------------------------!
64 PRIVATE
66 ENUM, BIND(C)
67 ENUMERATOR :: undefined=0, primitive=1, conservative=2
68 END ENUM
69 TYPE, ABSTRACT, EXTENDS(logging_base) :: physics_base
71 CLASS(constants_base), ALLOCATABLE :: constants
74 REAL :: time,& !< simulation time
75 mu, & !< mean molecular weight
76 eps
77 INTEGER :: vnum, & !< number of variables
78 pnum, & !< number of passive variables
79 vdim, & !< vector dimensions (1, 2 or 3)
80 density,pressure, &
81 energy,sgspressure, &
82 sgsenergy, &
83 xvelocity,xmomentum, &
84 yvelocity,ymomentum,&
85 zvelocity,zmomentum
86 INTEGER,ALLOCATABLE :: vidx(:)
87 LOGICAL :: supports_absorbing
89 LOGICAL :: supports_farfield
91 LOGICAL :: advanced_wave_speeds
92 CHARACTER(LEN=16), DIMENSION(:), POINTER &
93 :: pvarname,cvarname
96 REAL, DIMENSION(:,:,:), POINTER :: &
97 bcradius, & !< distance to the origin bary center values
98 divposvec, & !< divergence of the position vector
99 bphi, & !< bary centered constant gravitational potential
100 tmp,tmp1,tmp2,tmp3, &
101 tmp4,tmp5
102 REAL, DIMENSION(:,:,:,:), POINTER :: &
103 fradius, & !< distance to the origin face values
104 bcposvec, & !< curvilinear components of the position vector bary center values
105 w => null(), &
106 fphi, &
107 hy
108 REAL, DIMENSION(:,:,:,:,:), POINTER &
109 :: fcent, & !< centrifugal force
110 fposvec
111!------------------------------------------------------------!
112 CONTAINS
113 PROCEDURE :: initphysics_base
114 procedure(initphysics), DEFERRED, pass(this) :: initphysics
115 procedure(new_statevector), DEFERRED, pass(this) :: new_statevector
116 procedure(externalsources), DEFERRED, pass(this) :: externalsources
117 procedure(setoutput), DEFERRED, pass(this) :: setoutput
118 !------Convert2Primitve--------!
119 procedure(convert2primitive_all), DEFERRED :: convert2primitive_all
120 procedure(convert2primitive_subset), DEFERRED :: convert2primitive_subset
121 generic :: convert2primitive => &
122 convert2primitive_all, &
123 convert2primitive_subset
124 !------Convert2Conservative----!
125 procedure(convert2conservative_all), DEFERRED :: convert2conservative_all
126 procedure(convert2conservative_subset), DEFERRED :: convert2conservative_subset
127 generic :: convert2conservative => &
128 convert2conservative_all, &
129 convert2conservative_subset
130 !------Wavespeed Routines-----!
131 procedure(calcwavespeeds_center), DEFERRED :: calcwavespeeds_center
132 procedure(calcwavespeeds_faces), DEFERRED :: calcwavespeeds_faces
133 generic :: calculatewavespeeds => &
134 calcwavespeeds_center, &
135 calcwavespeeds_faces
136 !------Flux Routines-----------!
137 procedure(calcfluxesx), DEFERRED :: calcfluxesx
138 generic :: calculatefluxesx => calcfluxesx
139 procedure(calcfluxesy), DEFERRED :: calcfluxesy
140 generic :: calculatefluxesy => calcfluxesy
141 procedure(calcfluxesz), DEFERRED :: calcfluxesz
142 generic :: calculatefluxesz => calcfluxesz
143 !------Fargo Routines-----------!
144 procedure(addbackgroundvelocityx), DEFERRED :: addbackgroundvelocityx
145 procedure(subtractbackgroundvelocityx), DEFERRED :: subtractbackgroundvelocityx
146 procedure(addbackgroundvelocityy), DEFERRED :: addbackgroundvelocityy
147 procedure(subtractbackgroundvelocityy), DEFERRED :: subtractbackgroundvelocityy
148 procedure(addbackgroundvelocityz), DEFERRED :: addbackgroundvelocityz
149 procedure(subtractbackgroundvelocityz), DEFERRED :: subtractbackgroundvelocityz
150 procedure(addfargosourcesx), DEFERRED :: addfargosourcesx
151 procedure(addfargosourcesy), DEFERRED :: addfargosourcesy
152 procedure(addfargosourcesz), DEFERRED :: addfargosourcesz
153 !------Geometry Routines-------!
154 procedure(geometricalsources), DEFERRED :: geometricalsources
155 procedure(masks), DEFERRED :: reflectionmasks
156 procedure(masks), DEFERRED :: axismasks
157 !------Boundary Conditions-----!
158 ! absorbing boundaries
159 procedure(calculatecharsystemx), DEFERRED :: calculatecharsystemx
160 procedure(calculatecharsystemy), DEFERRED :: calculatecharsystemy
161 procedure(calculatecharsystemz), DEFERRED :: calculatecharsystemz
162 procedure(calculateboundarydatax), DEFERRED :: calculateboundarydatax
163 procedure(calculateboundarydatay), DEFERRED :: calculateboundarydatay
164 procedure(calculateboundarydataz), DEFERRED :: calculateboundarydataz
165 ! far field boundaries
166 procedure(calculateprim2riemannx), DEFERRED :: calculateprim2riemannx
167 procedure(calculateprim2riemanny), DEFERRED :: calculateprim2riemanny
168 procedure(calculateprim2riemannz), DEFERRED :: calculateprim2riemannz
169 procedure(calculateriemann2primx), DEFERRED :: calculateriemann2primx
170 procedure(calculateriemann2primy), DEFERRED :: calculateriemann2primy
171 procedure(calculateriemann2primz), DEFERRED :: calculateriemann2primz
172! PROCEDURE :: SGSSources
173! PROCEDURE :: CalculateSGSTensor
174! PROCEDURE :: GetSoundSpeed_adiabatic
175
176 procedure(finalize), DEFERRED :: finalize
177 PROCEDURE :: finalize_base
178 END TYPE physics_base
179
180 abstract INTERFACE
181 SUBROUTINE initphysics(this,Mesh,config,IO)
183 IMPLICIT NONE
184 CLASS(physics_base), INTENT(INOUT) :: this
185 CLASS(mesh_base), INTENT(IN) :: Mesh
186 TYPE(dict_typ), POINTER :: config, IO
187 END SUBROUTINE
188 SUBROUTINE setoutput(this,Mesh,config,IO)
190 IMPLICIT NONE
191 CLASS(physics_base), INTENT(INOUT) :: this
192 CLASS(mesh_base), INTENT(IN) :: Mesh
193 TYPE(dict_typ), POINTER :: config, IO
194 END SUBROUTINE
195 SUBROUTINE new_statevector(this,new_sv,flavour,num)
197 IMPLICIT NONE
198 CLASS(physics_base), INTENT(IN) :: this
199 CLASS(marray_compound), POINTER :: new_sv
200 INTEGER, OPTIONAL, INTENT(IN) :: flavour,num
201 END SUBROUTINE
202 PURE SUBROUTINE convert2primitive_all(this,cvar,pvar)
204 CLASS(physics_base), INTENT(IN) :: this
205 CLASS(marray_compound), INTENT(INOUT) :: cvar,pvar
206 END SUBROUTINE
207 PURE SUBROUTINE convert2primitive_subset(this,i1,i2,j1,j2,k1,k2,cvar,pvar)
209 CLASS(physics_base), INTENT(IN) :: this
210 INTEGER, INTENT(IN) :: i1,i2,j1,j2,k1,k2
211 CLASS(marray_compound), INTENT(INOUT) :: cvar,pvar
212 END SUBROUTINE
213 PURE SUBROUTINE convert2conservative_all(this,pvar,cvar)
215 CLASS(physics_base), INTENT(IN) :: this
216 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
217 END SUBROUTINE
218 PURE SUBROUTINE convert2conservative_subset(this,i1,i2,j1,j2,k1,k2,pvar,cvar)
220 CLASS(physics_base), INTENT(IN) :: this
221 INTEGER, INTENT(IN) :: i1,i2,j1,j2,k1,k2
222 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
223 END SUBROUTINE
224 SUBROUTINE externalsources(this,accel,pvar,cvar,sterm)
226 CLASS(physics_base), INTENT(IN) :: this
227 CLASS(marray_base), INTENT(IN) :: accel
228 CLASS(marray_compound), INTENT(IN) :: pvar,cvar
229 CLASS(marray_compound), INTENT(INOUT) :: sterm
230 END SUBROUTINE
231 PURE SUBROUTINE calcwavespeeds_center(this,Mesh,pvar,minwav,maxwav)
233 CLASS(physics_base), INTENT(INOUT) :: this
234 CLASS(mesh_base), INTENT(IN) :: mesh
235 CLASS(marray_compound), INTENT(INOUT) :: pvar
236 TYPE(marray_base), INTENT(INOUT) :: minwav,maxwav
237 END SUBROUTINE
238 PURE SUBROUTINE calcwavespeeds_faces(this,Mesh,prim,cons,minwav,maxwav)
240 CLASS(physics_base), INTENT(INOUT) :: this
241 CLASS(mesh_base), INTENT(IN) :: mesh
242 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,Mesh%NFACES,this%VNUM), &
243 INTENT(IN) :: prim,cons
244 TYPE(marray_base), INTENT(INOUT) :: minwav,maxwav
245 END SUBROUTINE
246 PURE SUBROUTINE calcfluxesx(this,Mesh,nmin,nmax,prim,cons,xfluxes)
248 CLASS(physics_base), INTENT(IN) :: this
249 CLASS(mesh_base), INTENT(IN) :: mesh
250 INTEGER, INTENT(IN) :: nmin,nmax
251 CLASS(marray_compound), INTENT(INOUT) :: prim,cons,xfluxes
252 END SUBROUTINE
253 PURE SUBROUTINE calcfluxesy(this,Mesh,nmin,nmax,prim,cons,yfluxes)
255 CLASS(physics_base), INTENT(IN) :: this
256 CLASS(mesh_base), INTENT(IN) :: mesh
257 INTEGER, INTENT(IN) :: nmin,nmax
258 CLASS(marray_compound), INTENT(INOUT) :: prim,cons,yfluxes
259 END SUBROUTINE
260 PURE SUBROUTINE calcfluxesz(this,Mesh,nmin,nmax,prim,cons,zfluxes)
262 CLASS(physics_base), INTENT(IN) :: this
263 CLASS(mesh_base), INTENT(IN) :: mesh
264 INTEGER, INTENT(IN) :: nmin,nmax
265 CLASS(marray_compound), INTENT(INOUT) :: prim,cons,zfluxes
266 END SUBROUTINE
267 PURE SUBROUTINE addbackgroundvelocityx(this,Mesh,w,pvar,cvar)
269 CLASS(physics_base), INTENT(INOUT) :: this
270 CLASS(mesh_base), INTENT(IN) :: mesh
271 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX), &
272 INTENT(IN) :: w
273 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
274 END SUBROUTINE addbackgroundvelocityx
275 PURE SUBROUTINE addbackgroundvelocityy(this,Mesh,w,pvar,cvar)
277 CLASS(physics_base), INTENT(INOUT) :: this
278 CLASS(mesh_base), INTENT(IN) :: mesh
279 REAL, DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX), &
280 INTENT(IN) :: w
281 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
282 END SUBROUTINE addbackgroundvelocityy
283 PURE SUBROUTINE addbackgroundvelocityz(this,Mesh,w,pvar,cvar)
285 CLASS(physics_base), INTENT(INOUT) :: this
286 CLASS(mesh_base), INTENT(IN) :: mesh
287 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX), &
288 INTENT(IN) :: w
289 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
290 END SUBROUTINE addbackgroundvelocityz
291 PURE SUBROUTINE subtractbackgroundvelocityx(this,Mesh,w,pvar,cvar)
293 CLASS(physics_base), INTENT(INOUT) :: this
294 CLASS(mesh_base), INTENT(IN) :: mesh
295 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX), &
296 INTENT(IN) :: w
297 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
298 END SUBROUTINE subtractbackgroundvelocityx
299 PURE SUBROUTINE subtractbackgroundvelocityy(this,Mesh,w,pvar,cvar)
301 CLASS(physics_base), INTENT(INOUT) :: this
302 CLASS(mesh_base), INTENT(IN) :: mesh
303 REAL, DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX), &
304 INTENT(IN) :: w
305 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
306 END SUBROUTINE subtractbackgroundvelocityy
307 PURE SUBROUTINE subtractbackgroundvelocityz(this,Mesh,w,pvar,cvar)
309 CLASS(physics_base), INTENT(INOUT) :: this
310 CLASS(mesh_base), INTENT(IN) :: mesh
311 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX), &
312 INTENT(IN) :: w
313 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar
314 END SUBROUTINE subtractbackgroundvelocityz
315 PURE SUBROUTINE geometricalsources(this,Mesh,pvar,cvar,sterm)
317 CLASS(physics_base), INTENT(INOUT) :: this
318 CLASS(mesh_base), INTENT(IN) :: mesh
319 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar,sterm
320 END SUBROUTINE
321 PURE SUBROUTINE addfargosourcesx(this,Mesh,w,pvar,cvar,sterm)
323 CLASS(physics_base), INTENT(INOUT) :: this
324 CLASS(mesh_base), INTENT(IN) :: mesh
325 REAL, DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX), &
326 INTENT(IN) :: w
327 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar,sterm
328 END SUBROUTINE addfargosourcesx
329 PURE SUBROUTINE addfargosourcesy(this,Mesh,w,pvar,cvar,sterm)
331 CLASS(physics_base), INTENT(INOUT) :: this
332 CLASS(mesh_base), INTENT(IN) :: mesh
333 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX), &
334 INTENT(IN) :: w
335 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar,sterm
336 END SUBROUTINE addfargosourcesy
337 PURE SUBROUTINE addfargosourcesz(this,Mesh,w,pvar,cvar,sterm)
339 CLASS(physics_base), INTENT(INOUT) :: this
340 CLASS(mesh_base), INTENT(IN) :: mesh
341 REAL, DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX), &
342 INTENT(IN) :: w
343 CLASS(marray_compound), INTENT(INOUT) :: pvar,cvar,sterm
344 END SUBROUTINE addfargosourcesz
345 PURE SUBROUTINE masks(this,Mesh,reflX,reflY,reflZ)
346 IMPORT physics_base, mesh_base
347 CLASS(physics_base), INTENT(IN) :: this
348 CLASS(mesh_base), INTENT(IN) :: mesh
349 LOGICAL, DIMENSION(this%VNUM), INTENT(OUT) :: reflx,refly,reflz
350 END SUBROUTINE
351 PURE SUBROUTINE calculatecharsystemx(this,Mesh,i1,i2,pvar,lambda,xvar)
353 !----------------------------------------------------------------------!
354 CLASS(physics_base), INTENT(IN) :: this
355 CLASS(mesh_base), INTENT(IN) :: mesh
356 INTEGER, INTENT(IN) :: i1,i2
357 CLASS(marray_compound), INTENT(INOUT) :: pvar
358 REAL,DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM), &
359 INTENT(OUT) :: lambda,xvar
360 END SUBROUTINE
361 PURE SUBROUTINE calculatecharsystemy(this,Mesh,j1,j2,pvar,lambda,xvar)
363 !----------------------------------------------------------------------!
364 CLASS(physics_base), INTENT(IN) :: this
365 CLASS(mesh_base), INTENT(IN) :: mesh
366 INTEGER, INTENT(IN) :: j1,j2
367 CLASS(marray_compound), INTENT(INOUT) :: pvar
368 REAL,DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM), &
369 INTENT(OUT) :: lambda,xvar
370 END SUBROUTINE
371 PURE SUBROUTINE calculatecharsystemz(this,Mesh,k1,k2,pvar,lambda,xvar)
373 !----------------------------------------------------------------------!
374 CLASS(physics_base), INTENT(IN) :: this
375 CLASS(mesh_base), INTENT(IN) :: mesh
376 INTEGER, INTENT(IN) :: k1,k2
377 CLASS(marray_compound), INTENT(INOUT) :: pvar
378 REAL,DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM), &
379 INTENT(OUT) :: lambda,xvar
380 END SUBROUTINE
381 PURE SUBROUTINE calculateboundarydatax(this,Mesh,i1,i2,xvar,pvar)
383 CLASS(physics_base), INTENT(IN) :: this
384 CLASS(mesh_base), INTENT(IN) :: mesh
385 INTEGER, INTENT(IN) :: i1,i2
386 REAL,DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,this%VNUM), INTENT(IN) :: xvar
387 CLASS(marray_compound), INTENT(INOUT) :: pvar
388 END SUBROUTINE
389 PURE SUBROUTINE calculateboundarydatay(this,Mesh,j1,j2,xvar,pvar)
391 CLASS(physics_base), INTENT(IN) :: this
392 CLASS(mesh_base), INTENT(IN) :: mesh
393 INTEGER, INTENT(IN) :: j1,j2
394 REAL,DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX,this%VNUM), INTENT(IN) :: xvar
395 CLASS(marray_compound), INTENT(INOUT) :: pvar
396 END SUBROUTINE
397 PURE SUBROUTINE calculateboundarydataz(this,Mesh,k1,k2,xvar,pvar)
399 CLASS(physics_base), INTENT(IN) :: this
400 CLASS(mesh_base), INTENT(IN) :: mesh
401 INTEGER, INTENT(IN) :: k1,k2
402 REAL,DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,this%VNUM), INTENT(IN) :: xvar
403 CLASS(marray_compound), INTENT(INOUT) :: pvar
404 END SUBROUTINE
405 PURE SUBROUTINE calculateprim2riemannx(this,Mesh,i,pvar,lambda,Rinv)
407 IMPLICIT NONE
408 !------------------------------------------------------------------------!
409 CLASS(physics_base), INTENT(IN) :: this
410 CLASS(mesh_base), INTENT(IN) :: mesh
411 INTEGER, INTENT(IN) :: i
412 CLASS(marray_compound), INTENT(IN) :: pvar
413 REAL, INTENT(OUT), &
414 DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
415 :: lambda
416 REAL, INTENT(OUT), &
417 DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
418 :: rinv
419 END SUBROUTINE
420 PURE SUBROUTINE calculateprim2riemanny(this,Mesh,j,pvar,lambda,Rinv)
422 IMPLICIT NONE
423 !------------------------------------------------------------------------!
424 CLASS(physics_base), INTENT(IN) :: this
425 CLASS(mesh_base), INTENT(IN) :: mesh
426 INTEGER, INTENT(IN) :: j
427 CLASS(marray_compound), INTENT(IN) :: pvar
428 REAL, INTENT(OUT), &
429 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
430 :: lambda
431 REAL, INTENT(OUT), &
432 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
433 :: rinv
434 END SUBROUTINE
435 PURE SUBROUTINE calculateprim2riemannz(this,Mesh,k,pvar,lambda,Rinv)
437 IMPLICIT NONE
438 !------------------------------------------------------------------------!
439 CLASS(physics_base), INTENT(IN) :: this
440 CLASS(mesh_base), INTENT(IN) :: mesh
441 INTEGER, INTENT(IN) :: k
442 CLASS(marray_compound), INTENT(IN) :: pvar
443 REAL, INTENT(OUT), &
444 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM) &
445 :: lambda
446 REAL, INTENT(OUT), &
447 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM) &
448 :: rinv
449 END SUBROUTINE
450 PURE SUBROUTINE calculateriemann2primx(this,Mesh,i,Rinv,pvar)
452 IMPLICIT NONE
453 !------------------------------------------------------------------------!
454 CLASS(physics_base), INTENT(IN) :: this
455 CLASS(mesh_base), INTENT(IN) :: mesh
456 INTEGER, INTENT(IN) :: i
457 REAL, INTENT(IN), &
458 DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
459 :: rinv
460 CLASS(marray_compound), INTENT(INOUT) :: pvar
461 END SUBROUTINE
462 PURE SUBROUTINE calculateriemann2primy(this,Mesh,j,Rinv,pvar)
464 IMPLICIT NONE
465 !------------------------------------------------------------------------!
466 CLASS(physics_base), INTENT(IN) :: this
467 CLASS(mesh_base), INTENT(IN) :: mesh
468 INTEGER, INTENT(IN) :: j
469 REAL, INTENT(IN), &
470 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
471 :: rinv
472 CLASS(marray_compound), INTENT(INOUT) :: pvar
473 END SUBROUTINE
474 PURE SUBROUTINE calculateriemann2primz(this,Mesh,k,Rinv,pvar)
476 IMPLICIT NONE
477 !------------------------------------------------------------------------!
478 CLASS(physics_base), INTENT(IN) :: this
479 CLASS(mesh_base), INTENT(IN) :: mesh
480 INTEGER, INTENT(IN) :: k
481 REAL, INTENT(IN), &
482 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM) &
483 :: rinv
484 CLASS(marray_compound), INTENT(INOUT) :: pvar
485 END SUBROUTINE
486 SUBROUTINE finalize(this)
487 IMPORT physics_base
488 IMPLICIT NONE
489 CLASS(physics_base),INTENT(INOUT) :: this
490 END SUBROUTINE
491
492 END INTERFACE
493 !--------------------------------------------------------------------------!
494 ! flags for advection problems
495! INTEGER, PARAMETER :: EULER2D = 1
496 INTEGER, PARAMETER :: euler_isotherm = 16
498 INTEGER, PARAMETER :: euler = 17
500! INTEGER, PARAMETER :: EULER2D_ISOTHERM = 2
501! INTEGER, PARAMETER :: EULER3D_ROTSYM = 3
502! INTEGER, PARAMETER :: EULER3D_ROTAMT = 4
503! INTEGER, PARAMETER :: EULER3D_ROTSYMSGS = 5
504! INTEGER, PARAMETER :: EULER2D_SGS = 7
505! INTEGER, PARAMETER :: EULER3D_ROTAMTSGS = 8
506! INTEGER, PARAMETER :: EULER2D_ISOIAMT = 9
507! INTEGER, PARAMETER :: EULER2D_IAMT = 11
508! INTEGER, PARAMETER :: EULER2D_IAMROT = 12
509! INTEGER, PARAMETER :: EULER2D_ISOIAMROT = 13
510! INTEGER, PARAMETER :: EULER3D_ISOTHERM = 14
511! INTEGER, PARAMETER :: EULER3D = 15
512 !--------------------------------------------------------------------------!
513 PUBLIC :: &
514 ! types
515 physics_base, &
516 ! constants - flags for identification in dictionary by an integer
518 si, cgs, geometrical, &
520 !--------------------------------------------------------------------------!
521
522CONTAINS
523
531 SUBROUTINE initphysics_base(this,Mesh,config,IO,problem,pname)
532 IMPLICIT NONE
533 !------------------------------------------------------------------------!
534 CLASS(physics_base), INTENT(INOUT) :: this
535 CLASS(mesh_base),INTENT(IN) :: Mesh
536 TYPE(dict_typ),POINTER &
537 :: config, IO
538 INTEGER :: problem
539 CHARACTER(LEN=32) :: pname
540 CHARACTER(LEN=64) :: info_str
541 !------------------------------------------------------------------------!
542 INTEGER :: units
543 INTEGER :: err, valwrite, n
544 !------------------------------------------------------------------------!
545 INTENT(IN) :: problem
546 !------------------------------------------------------------------------!
547 CALL this%InitLogging(problem,pname)
548
549 ! check initialization of Mesh
550 IF (.NOT.mesh%Initialized()) &
551 CALL this%Error("InitPhysics","mesh module uninitialized")
552
553 ! units
554 CALL getattr(config, "units", units, si)
555 CALL new_constants(this%constants, units)
556
557 CALL this%Info(" PHYSICS--> advection problem: " // trim(this%GetName()))
558
559 ! mean molecular weight
560 CALL getattr(config, "mu", this%mu, 0.029)
561
562 ! enable advanced wave speed estimates (computationally more expensive)
563 ! uses Roe averages between cell boundaries
564 CALL getattr(config, "advanced_wave_speeds", valwrite, 0)
565 IF (valwrite .EQ. 1) THEN
566 this%advanced_wave_speeds = .true.
567 ELSE
568 this%advanced_wave_speeds = .false.
569 END IF
570
571 ! softening parameter to smooth out singularity near center of rotation
572 ! (only necessary, if it's inside the computational domain)
573 ! set to 0.0 to disable
574 ! the softening length is the product of this parameter and the
575 ! size of the grid cell next to the center of rotation; thus a value larger
576 ! than 1.0 leads to larger softening whereas smaller values will
577 ! probably cause odd behaviour due to the 1/r singularity;
578 ! if the minimal r on the computational domain is larger than
579 ! the size of the associated grid cell, softening is disabled, because
580 ! the center of rotation lies outside of the computational domain
581 CALL getattr(config, "softening", this%eps, 1.0)
582
583 ! determine physical vector dimensions based on dimimensionality of the grid
584 ! and whether rotational symmetry is assumed
585 this%VDIM = mesh%NDIMS
586 IF (mesh%ROTSYM.GT.0) this%VDIM = this%VDIM + 1
587
588 ! set this to appropriate values in derived classes
589 this%VNUM = 0 ! number of hydrodynamical variables in state vector
590 this%PNUM = 0 ! number of passive scalars in state vector
591
592 ! allocate memory for arrays common to all physics modules
593 ALLOCATE(this%tmp(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX), &
594 this%tmp1(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX), &
595 this%tmp2(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX), &
596 this%tmp3(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX), &
597 this%tmp4(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX), &
598 this%tmp5(mesh%IGMIN:mesh%IGMAX,mesh%JGMIN:mesh%JGMAX,mesh%KGMIN:mesh%KGMAX), &
599 this%VIDX(this%VDIM), &
600 stat = err)
601 IF (err.NE.0) &
602 CALL this%Error("InitPhysics", "Unable to allocate memory.")
603
604 ! Determine which dimensions of a 3D vector are actually used in physical vectors
605 n = 1
606 IF (btest(mesh%VECTOR_COMPONENTS,0)) THEN
607 ! first dimension, i.e. x-component, available
608 this%VIDX(n) = 1
609 n = n + 1
610 END IF
611 IF (btest(mesh%VECTOR_COMPONENTS,1)) THEN
612 ! second dimension, i.e. y-component, available
613 this%VIDX(n) = 2
614 n = n + 1
615 END IF
616 IF (btest(mesh%VECTOR_COMPONENTS,2)) THEN
617 ! third dimension, i.e. z-component, available
618 this%VIDX(n) = 3
619 END IF
620
621 this%tmp(:,:,:) = 0.
622 this%tmp1(:,:,:) = 0.
623 this%tmp2(:,:,:) = 0.
624 this%tmp3(:,:,:) = 0.
625 this%tmp4(:,:,:) = 0.
626 this%tmp5(:,:,:) = 0.
627
628 ! disable absorbing and farfield boundary conditions by default
629 this%supports_absorbing = .false.
630 this%supports_farfield = .false.
631
632 this%time = -1.
633
634 ! print some information
635 WRITE(info_str,'("vector dimensions:",I2)') this%VDIM
636 CALL this%Info(repeat(" ",12) // trim(info_str))
637 END SUBROUTINE initphysics_base
638
640 SUBROUTINE finalize_base(this)
641 IMPLICIT NONE
642 !------------------------------------------------------------------------!
643 CLASS(physics_base), INTENT(INOUT) :: this
644 !------------------------------------------------------------------------!
645 IF (.NOT.this%Initialized()) &
646 CALL this%Error("ClosePhysics","not initialized")
647 ! deallocate pointer variables used in all physics modules
648 DEALLOCATE(this%tmp,this%tmp1,this%tmp2,this%tmp3,this%tmp4,this%tmp5, &
649 this%pvarname,this%cvarname,this%VIDX)
650 END SUBROUTINE finalize_base
651
652END MODULE physics_base_mod
Dictionary for generic data types.
Definition: common_dict.f90:61
type(logging_base), save this
constructor for constants class
subroutine new_constants(Constants, units)
Basic fosite module.
subroutine finalize(this)
Destructor of logging_base class.
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 finalize_base(this)
Destructor of mesh class.
Definition: mesh_base.f90:1549
subroutine setoutput(this, config, IO)
Setup mesh fields for i/o.
Definition: mesh_base.f90:828
Basic physics module.
@, public primitive
@, public undefined
subroutine initphysics_base(this, Mesh, config, IO, problem, pname)
Initialization for the base physical object.
integer, parameter, public euler_isotherm
integer, parameter, public euler
@, public conservative
common data structure
basic mesh array class
Definition: marray_base.f90:69
mesh data structure
Definition: mesh_base.f90:122