23 procedure,
nopass:: cast2solver
32 procedure:: log_density => void
33 procedure:: log_pressure => void
40 procedure:: velocity_magnitude => void
41 procedure:: magnetic_field_magnitude => void
42 procedure:: grav_potential => void
43 procedure:: apply_heating
44 procedure:: compression_magnitude
45 procedure:: vorticity_magnitude
46 procedure:: gas_velocity_vector
47 procedure:: gas_velocity_scalar
55 SUBROUTINE init (self)
58 call self%mhd_t%pre_init
66 FUNCTION cast2solver (task)
RESULT(solver)
67 class(
task_t),
pointer:: task
75 call io%abort (
'solver_t%cast2solver: failed to cast a task to solver_t')
77 END FUNCTION cast2solver
82 SUBROUTINE update (self)
84 associate(d=>self%mem(:,:,:,self%idx%d,self%it,1))
86 call trace%begin (
'solver_t%update')
87 call self%mhd_t%pre_update
88 call validate%check (self, d,
'before update')
89 call self%mhd_t%update
90 call validate%check (self, d,
' after update')
91 call self%mhd_t%post_update
99 SUBROUTINE p2u(self, U, it)
101 real,
dimension(:,:,:,:),
pointer:: u
104 real,
dimension(:,:,:,:),
allocatable:: dd
106 associate(d => self%mem(:,:,:,self%idx%d, it,1), &
107 p => self%mem(:,:,:,self%idx%px:self%idx%pz,it,1))
108 allocate(dd(
size(d,1),
size(d,2),
size(d,3),3))
109 if (self%kind(1:13) ==
'stagger2e_pic')
then 123 SUBROUTINE u2p(self, U, it)
125 real,
dimension(:,:,:,:),
pointer:: u
128 real,
dimension(:,:,:,:),
allocatable:: dd
130 associate(d => self%mem(:,:,:,self%idx%d ,it,1), &
131 p => self%mem(:,:,:,self%idx%px:self%idx%pz,it,1))
132 allocate(dd(
size(d,1),
size(d,2),
size(d,3),3))
133 if (self%kind(1:13) ==
'stagger2e_pic')
then 147 SUBROUTINE e2e_th(self, E_th, it)
151 real,
dimension(:,:,:),
pointer:: e_th
154 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
155 s => self%mem(:,:,:,self%idx%s,it,1))
157 e_th = d**g1*exp(s*g1/d)/g1
159 END SUBROUTINE e2e_th
164 SUBROUTINE e_th2e(self, E_th, it)
168 real,
dimension(:,:,:),
pointer:: e_th
171 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
172 s => self%mem(:,:,:,self%idx%s,it,1))
174 s = d*log(e_th*g1/d**g1)/g1
176 END SUBROUTINE e_th2e
181 SUBROUTINE e2s(self, s, it)
185 real,
dimension(:,:,:):: s
188 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
189 e => self%mem(:,:,:,self%idx%s,it,1))
191 s = d*log(e*g1/d**self%gamma)/g1
198 SUBROUTINE e2ss(self, ss, it)
202 real,
dimension(:,:,:):: ss
205 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
206 e => self%mem(:,:,:,self%idx%s,it,1))
208 ss = log(e*g1/d**self%gamma)/g1
215 SUBROUTINE s2e(self, s, it)
219 real,
dimension(:,:,:):: s
222 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
223 e => self%mem(:,:,:,self%idx%s,it,1))
225 e = d**self%gamma*exp(s/d*g1)/g1
232 SUBROUTINE ss2e(self, ss, it)
236 real,
dimension(:,:,:):: ss
239 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
240 e => self%mem(:,:,:,self%idx%s,it,1))
242 e = d**self%gamma*exp(ss*g1)/g1
285 SUBROUTINE log_density (self, v)
287 real,
dimension(:,:,:),
pointer:: v
289 v = log(self%mem(:,:,:,self%id,self%it,1))
293 SUBROUTINE log_pressure (self, lnd, ss, v)
295 real,
dimension(:,:,:),
pointer:: lnd, ss, v
297 v = log(self%gas_pressure())
301 SUBROUTINE velocity_magnitude (self, v)
303 real,
dimension(:,:,:),
pointer:: v
304 real,
dimension(:,:,:,:),
pointer:: p
306 p => self%mem(:,:,:,self%idx%px:self%idx%px,self%it,1)
307 if (self%kind(1:13) ==
'stagger2e_pic')
then 308 v = norm(p/exp(up(log(self%mem(:,:,:,self%id,self%it,1)))))
310 v = norm(p/exp(down(log(self%mem(:,:,:,self%id,self%it,1)))))
315 SUBROUTINE magnetic_field_magnitude (self, v)
317 real,
dimension(:,:,:),
pointer:: v
318 real,
dimension(:,:,:,:),
pointer:: b
320 b => self%mem(:,:,:,self%idx%bx:self%idx%bx,self%it,1)
325 SUBROUTINE void (self, v)
327 real,
dimension(:,:,:),
pointer:: v
333 SUBROUTINE apply_heating (self, q)
335 real,
dimension(:,:,:):: q
339 FUNCTION gas_velocity_vector (self)
RESULT (v)
342 real(kind=KindScalarVar),
dimension(:,:,:),
pointer :: d
343 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable :: lnd
344 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: p
345 real(kind=KindScalarVar),
dimension(:,:,:,:),
allocatable:: ld, dd
346 real(kind=KindScalarVar),
dimension(self%gn(1),self%gn(2),self%gn(3),3):: v
348 d => self%mem(:,:,:,self%idx%d,self%it,1)
349 p => self%mem(:,:,:,self%idx%px:self%idx%pz,self%it,1)
350 call allocate_vectors_a (self%gn, ld, dd)
351 call allocate_scalars_a (self%gn, lnd)
352 if (self%kind(1:13) ==
'stagger2e_pic')
then 363 call deallocate_vectors_a (ld, dd)
364 call deallocate_scalars_a (lnd)
366 END FUNCTION gas_velocity_vector
369 FUNCTION gas_velocity_scalar (self, idir)
RESULT (v)
373 real(kind=KindScalarVar),
dimension(:,:,:),
pointer:: d
374 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: lnd, ld, dd
375 real(kind=KindScalarVar),
dimension(self%gn(1),self%gn(2),self%gn(3)):: v
377 d => self%mem(:,:,:,self%idx%d,self%it,1)
378 call allocate_scalars_a (self%gn, lnd, ld, dd)
380 if (self%kind(1:13) ==
'stagger2e_pic')
then 385 v = self%mem(:,:,:,self%idx%px,self%it,1) / dd
389 v = self%mem(:,:,:,self%idx%py,self%it,1) / dd
393 v = self%mem(:,:,:,self%idx%pz,self%it,1) / dd
395 call io%abort (
"solver_mod::gas_velocity_scalar:: invalid value of idir")
402 v = self%mem(:,:,:,self%idx%px,self%it,1) / dd
406 v = self%mem(:,:,:,self%idx%py,self%it,1) / dd
410 v = self%mem(:,:,:,self%idx%pz,self%it,1) / dd
412 call io%abort (
"solver_mod::gas_velocity_scalar:: invalid value of idir")
415 call deallocate_scalars_a (lnd, ld, dd)
417 END FUNCTION gas_velocity_scalar
423 SUBROUTINE compression_magnitude (self, w)
425 real(kind=KindScalarVar),
dimension(:,:,:):: w
426 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: d
427 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: vx, vy, vz
429 integer,
save:: itimer=0
431 call trace%begin (
'solver_t%compression_magnitude', itimer=itimer)
432 allocate (vx(self%gn(1),self%gn(2),self%gn(3)))
433 allocate (vy(self%gn(1),self%gn(2),self%gn(3)))
434 allocate (vz(self%gn(1),self%gn(2),self%gn(3)))
435 allocate ( d(self%gn(1),self%gn(2),self%gn(3),3))
436 if (self%kind(1:13) ==
'stagger2e_pic')
then 437 d = up(log(self%mem(:,:,:,self%idx%d,self%it,1)))
439 d = down(log(self%mem(:,:,:,self%idx%d,self%it,1)))
441 vx = self%mem(:,:,:,self%idx%px,self%it,1)/exp(d(:,:,:,1))
442 vy = self%mem(:,:,:,self%idx%py,self%it,1)/exp(d(:,:,:,2))
443 vz = self%mem(:,:,:,self%idx%pz,self%it,1)/exp(d(:,:,:,3))
444 if (self%kind(1:13) ==
'stagger2e_pic')
then 445 w = max(- ddxdn(self%ds,vx) &
446 - ddydn(self%ds,vy) &
447 - ddzdn(self%ds,vz), 0.0)
449 w = max(- ddxup(self%ds,vx) &
450 - ddyup(self%ds,vy) &
451 - ddzup(self%ds,vz), 0.0)
453 deallocate (vx, vy, vz, d)
454 call trace%end (itimer)
455 END SUBROUTINE compression_magnitude
460 SUBROUTINE vorticity_magnitude (self, w)
462 real(kind=KindScalarVar),
dimension(:,:,:):: w
463 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: d
464 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: vx, vy, vz
466 integer,
save:: itimer=0
468 call trace%begin (
'solver_t%vorticity_magnitude', itimer=itimer)
469 allocate (vx(self%gn(1),self%gn(2),self%gn(3)))
470 allocate (vy(self%gn(1),self%gn(2),self%gn(3)))
471 allocate (vz(self%gn(1),self%gn(2),self%gn(3)))
472 allocate ( d(self%gn(1),self%gn(2),self%gn(3),3))
473 if (self%kind(1:13) ==
'stagger2e_pic')
then 474 d = up(log(self%mem(:,:,:,self%idx%d,self%it,1)))
476 d = down(log(self%mem(:,:,:,self%idx%d,self%it,1)))
478 vx = self%mem(:,:,:,self%idx%px,self%it,1)/exp(d(:,:,:,1))
479 vy = self%mem(:,:,:,self%idx%py,self%it,1)/exp(d(:,:,:,2))
480 vz = self%mem(:,:,:,self%idx%pz,self%it,1)/exp(d(:,:,:,3))
481 if (self%kind(1:13) ==
'stagger2e_pic')
then 482 w = sqrt(ydn(zdn(ddyup(self%ds,vz)-ddzup(self%ds,vy)))**2 &
483 + zdn(xdn(ddzup(self%ds,vx)-ddxup(self%ds,vz)))**2 &
484 + xdn(ydn(ddxup(self%ds,vy)-ddyup(self%ds,vx)))**2)
486 w = sqrt(yup(zup(ddydn(self%ds,vz)-ddzdn(self%ds,vy)))**2 &
487 + zup(xup(ddzdn(self%ds,vx)-ddxdn(self%ds,vz)))**2 &
488 + xup(yup(ddxdn(self%ds,vy)-ddydn(self%ds,vx)))**2)
490 deallocate (vx, vy, vz)
491 call trace%end (itimer)
492 END SUBROUTINE vorticity_magnitude
Generic validation module. The general idea is to be able to compare two runs at critical points in t...
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
RAMSES Godunov solvers, use of guard zones; specifically in HLLD.
This module contains all experiment specific information necessary to solve the heat diffusion proble...
Template module for tasks.