71 CLASS(constants_base),
ALLOCATABLE :: constants
74 REAL :: time,& !< simulation time
75 mu, & !< mean molecular weight
77 INTEGER :: vnum, & !< number of variables
78 pnum, & !< number of passive variables
79 vdim, & !< vector dimensions (1, 2 or 3)
83 xvelocity,xmomentum, &
86 INTEGER,
ALLOCATABLE :: vidx(:)
87 LOGICAL :: supports_absorbing
89 LOGICAL :: supports_farfield
91 LOGICAL :: advanced_wave_speeds
92 CHARACTER(LEN=16),
DIMENSION(:),
POINTER &
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, &
102 REAL,
DIMENSION(:,:,:,:),
POINTER :: &
103 fradius, & !< distance to the origin face values
104 bcposvec, & !< curvilinear components of the position vector bary center values
108 REAL,
DIMENSION(:,:,:,:,:),
POINTER &
109 :: fcent, & !< centrifugal force
114 procedure(initphysics),
DEFERRED, pass(
this) :: initphysics
116 procedure(externalsources),
DEFERRED, pass(
this) :: externalsources
119 procedure(convert2primitive_all),
DEFERRED :: convert2primitive_all
120 procedure(convert2primitive_subset),
DEFERRED :: convert2primitive_subset
121 generic :: convert2primitive => &
122 convert2primitive_all, &
123 convert2primitive_subset
125 procedure(convert2conservative_all),
DEFERRED :: convert2conservative_all
126 procedure(convert2conservative_subset),
DEFERRED :: convert2conservative_subset
127 generic :: convert2conservative => &
128 convert2conservative_all, &
129 convert2conservative_subset
131 procedure(calcwavespeeds_center),
DEFERRED :: calcwavespeeds_center
132 procedure(calcwavespeeds_faces),
DEFERRED :: calcwavespeeds_faces
133 generic :: calculatewavespeeds => &
134 calcwavespeeds_center, &
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
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
154 procedure(geometricalsources),
DEFERRED :: geometricalsources
155 procedure(masks),
DEFERRED :: reflectionmasks
156 procedure(masks),
DEFERRED :: axismasks
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
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
181 SUBROUTINE initphysics(this,Mesh,config,IO)
186 TYPE(
dict_typ),
POINTER :: config, IO
193 TYPE(
dict_typ),
POINTER :: config, IO
200 INTEGER,
OPTIONAL,
INTENT(IN) :: flavour,num
202 PURE SUBROUTINE convert2primitive_all(this,cvar,pvar)
207 PURE SUBROUTINE convert2primitive_subset(this,i1,i2,j1,j2,k1,k2,cvar,pvar)
210 INTEGER,
INTENT(IN) :: i1,i2,j1,j2,k1,k2
213 PURE SUBROUTINE convert2conservative_all(this,pvar,cvar)
218 PURE SUBROUTINE convert2conservative_subset(this,i1,i2,j1,j2,k1,k2,pvar,cvar)
221 INTEGER,
INTENT(IN) :: i1,i2,j1,j2,k1,k2
224 SUBROUTINE externalsources(this,accel,pvar,cvar,sterm)
231 PURE SUBROUTINE calcwavespeeds_center(this,Mesh,pvar,minwav,maxwav)
238 PURE SUBROUTINE calcwavespeeds_faces(this,Mesh,prim,cons,minwav,maxwav)
242 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,Mesh%NFACES,this%VNUM), &
243 INTENT(IN) :: prim,cons
246 PURE SUBROUTINE calcfluxesx(this,Mesh,nmin,nmax,prim,cons,xfluxes)
250 INTEGER,
INTENT(IN) :: nmin,nmax
253 PURE SUBROUTINE calcfluxesy(this,Mesh,nmin,nmax,prim,cons,yfluxes)
257 INTEGER,
INTENT(IN) :: nmin,nmax
260 PURE SUBROUTINE calcfluxesz(this,Mesh,nmin,nmax,prim,cons,zfluxes)
264 INTEGER,
INTENT(IN) :: nmin,nmax
267 PURE SUBROUTINE addbackgroundvelocityx(this,Mesh,w,pvar,cvar)
271 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX), &
274 END SUBROUTINE addbackgroundvelocityx
275 PURE SUBROUTINE addbackgroundvelocityy(this,Mesh,w,pvar,cvar)
279 REAL,
DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX), &
282 END SUBROUTINE addbackgroundvelocityy
283 PURE SUBROUTINE addbackgroundvelocityz(this,Mesh,w,pvar,cvar)
287 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX), &
290 END SUBROUTINE addbackgroundvelocityz
291 PURE SUBROUTINE subtractbackgroundvelocityx(this,Mesh,w,pvar,cvar)
295 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX), &
298 END SUBROUTINE subtractbackgroundvelocityx
299 PURE SUBROUTINE subtractbackgroundvelocityy(this,Mesh,w,pvar,cvar)
303 REAL,
DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX), &
306 END SUBROUTINE subtractbackgroundvelocityy
307 PURE SUBROUTINE subtractbackgroundvelocityz(this,Mesh,w,pvar,cvar)
311 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX), &
314 END SUBROUTINE subtractbackgroundvelocityz
315 PURE SUBROUTINE geometricalsources(this,Mesh,pvar,cvar,sterm)
321 PURE SUBROUTINE addfargosourcesx(this,Mesh,w,pvar,cvar,sterm)
325 REAL,
DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX), &
328 END SUBROUTINE addfargosourcesx
329 PURE SUBROUTINE addfargosourcesy(this,Mesh,w,pvar,cvar,sterm)
333 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX), &
336 END SUBROUTINE addfargosourcesy
337 PURE SUBROUTINE addfargosourcesz(this,Mesh,w,pvar,cvar,sterm)
341 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX), &
344 END SUBROUTINE addfargosourcesz
345 PURE SUBROUTINE masks(this,Mesh,reflX,reflY,reflZ)
349 LOGICAL,
DIMENSION(this%VNUM),
INTENT(OUT) :: reflx,refly,reflz
351 PURE SUBROUTINE calculatecharsystemx(this,Mesh,i1,i2,pvar,lambda,xvar)
356 INTEGER,
INTENT(IN) :: i1,i2
358 REAL,
DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM), &
359 INTENT(OUT) :: lambda,xvar
361 PURE SUBROUTINE calculatecharsystemy(this,Mesh,j1,j2,pvar,lambda,xvar)
366 INTEGER,
INTENT(IN) :: j1,j2
368 REAL,
DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM), &
369 INTENT(OUT) :: lambda,xvar
371 PURE SUBROUTINE calculatecharsystemz(this,Mesh,k1,k2,pvar,lambda,xvar)
376 INTEGER,
INTENT(IN) :: k1,k2
378 REAL,
DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM), &
379 INTENT(OUT) :: lambda,xvar
381 PURE SUBROUTINE calculateboundarydatax(this,Mesh,i1,i2,xvar,pvar)
385 INTEGER,
INTENT(IN) :: i1,i2
386 REAL,
DIMENSION(Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,this%VNUM),
INTENT(IN) :: xvar
389 PURE SUBROUTINE calculateboundarydatay(this,Mesh,j1,j2,xvar,pvar)
393 INTEGER,
INTENT(IN) :: j1,j2
394 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%KGMIN:Mesh%KGMAX,this%VNUM),
INTENT(IN) :: xvar
397 PURE SUBROUTINE calculateboundarydataz(this,Mesh,k1,k2,xvar,pvar)
401 INTEGER,
INTENT(IN) :: k1,k2
402 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,this%VNUM),
INTENT(IN) :: xvar
405 PURE SUBROUTINE calculateprim2riemannx(this,Mesh,i,pvar,lambda,Rinv)
411 INTEGER,
INTENT(IN) :: i
414 DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
417 DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
420 PURE SUBROUTINE calculateprim2riemanny(this,Mesh,j,pvar,lambda,Rinv)
426 INTEGER,
INTENT(IN) :: j
429 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
432 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
435 PURE SUBROUTINE calculateprim2riemannz(this,Mesh,k,pvar,lambda,Rinv)
441 INTEGER,
INTENT(IN) :: k
444 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM) &
447 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM) &
450 PURE SUBROUTINE calculateriemann2primx(this,Mesh,i,Rinv,pvar)
456 INTEGER,
INTENT(IN) :: i
458 DIMENSION(Mesh%JMIN:Mesh%JMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
462 PURE SUBROUTINE calculateriemann2primy(this,Mesh,j,Rinv,pvar)
468 INTEGER,
INTENT(IN) :: j
470 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%KMIN:Mesh%KMAX,this%VNUM) &
474 PURE SUBROUTINE calculateriemann2primz(this,Mesh,k,Rinv,pvar)
480 INTEGER,
INTENT(IN) :: k
482 DIMENSION(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX,this%VNUM) &
518 si, cgs, geometrical, &
539 CHARACTER(LEN=32) :: pname
540 CHARACTER(LEN=64) :: info_str
543 INTEGER :: err, valwrite, n
545 INTENT(IN) :: problem
547 CALL this%InitLogging(problem,pname)
550 IF (.NOT.mesh%Initialized()) &
551 CALL this%Error(
"InitPhysics",
"mesh module uninitialized")
554 CALL getattr(config,
"units", units, si)
557 CALL this%Info(
" PHYSICS--> advection problem: " // trim(this%GetName()))
560 CALL getattr(config,
"mu", this%mu, 0.029)
564 CALL getattr(config,
"advanced_wave_speeds", valwrite, 0)
565 IF (valwrite .EQ. 1)
THEN
566 this%advanced_wave_speeds = .true.
568 this%advanced_wave_speeds = .false.
581 CALL getattr(config,
"softening", this%eps, 1.0)
585 this%VDIM = mesh%NDIMS
586 IF (mesh%ROTSYM.GT.0) this%VDIM = this%VDIM + 1
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), &
602 CALL this%Error(
"InitPhysics",
"Unable to allocate memory.")
606 IF (btest(mesh%VECTOR_COMPONENTS,0))
THEN
611 IF (btest(mesh%VECTOR_COMPONENTS,1))
THEN
616 IF (btest(mesh%VECTOR_COMPONENTS,2))
THEN
622 this%tmp1(:,:,:) = 0.
623 this%tmp2(:,:,:) = 0.
624 this%tmp3(:,:,:) = 0.
625 this%tmp4(:,:,:) = 0.
626 this%tmp5(:,:,:) = 0.
629 this%supports_absorbing = .false.
630 this%supports_farfield = .false.
635 WRITE(info_str,
'("vector dimensions:",I2)') this%VDIM
636 CALL this%Info(repeat(
" ",12) // trim(info_str))
645 IF (.NOT.this%Initialized()) &
646 CALL this%Error(
"ClosePhysics",
"not initialized")
648 DEALLOCATE(this%tmp,this%tmp1,this%tmp2,this%tmp3,this%tmp4,this%tmp5, &
649 this%pvarname,this%cvarname,this%VIDX)
Dictionary for generic data types.
type(logging_base), save this
constructor for constants class
subroutine new_constants(Constants, units)
subroutine finalize(this)
Destructor of logging_base class.
base class for mesh arrays
derived class for compound of mesh arrays
subroutine finalize_base(this)
Destructor of mesh class.
subroutine setoutput(this, config, IO)
Setup mesh fields for i/o.
subroutine initphysics_base(this, Mesh, config, IO, problem, pname)
Initialization for the base physical object.
integer, parameter, public euler_isotherm
integer, parameter, public euler