22 procedure,
nopass:: cast2solver
31 procedure:: log_density => void
32 procedure:: log_pressure => void
33 procedure:: gas_pressure_ngz
35 procedure:: gas_temperature
36 procedure:: gas_temperature_ngz
38 procedure:: velocity_magnitude => void
39 procedure:: magnetic_field_magnitude => void
40 procedure:: grav_potential => void
41 procedure:: apply_heating
42 procedure:: gas_velocity_vector
43 procedure:: gas_velocity_scalar
44 procedure:: compression_magnitude
45 procedure:: vorticity_magnitude
53 SUBROUTINE init (self)
57 call self%extras_t%init
64 SUBROUTINE update (self)
66 associate(d=>self%mem(:,:,:,self%idx%d,self%it,1))
68 call self%extras_t%pre_update
69 call validate%check (self, d,
'before update')
70 call self%mhd_t%update
71 call validate%check (self, d,
' after update')
72 call self%extras_t%post_update
79 FUNCTION cast2solver (task)
RESULT(solver)
80 class(task_t),
pointer:: task
88 call io%abort (
'patch_t%cast: failed to cast a task to patch_t')
90 END FUNCTION cast2solver
95 SUBROUTINE p2u(self, U, it)
97 real,
dimension(:,:,:,:),
pointer:: u
100 real,
dimension(:,:,:,:),
pointer:: dd
103 associate(d => self%mem(:,:,:,self%idx%d, it,1), &
104 p => self%mem(:,:,:,self%idx%px:self%idx%pz,it,1))
106 u(:,:,:,i) = p(:,:,:,i)/d
114 SUBROUTINE u2p(self, U, it)
116 real,
dimension(:,:,:,:),
pointer:: u
119 real,
dimension(:,:,:,:),
pointer:: dd
122 associate(d => self%mem(:,:,:,self%idx%d ,it,1), &
123 p => self%mem(:,:,:,self%idx%px:self%idx%pz,it,1))
125 p(:,:,:,i) = u(:,:,:,i)*d
133 SUBROUTINE e2e_th(self, E_th, it)
137 real,
dimension(:,:,:),
pointer:: e_th
140 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
141 e => self%mem(:,:,:,self%idx%e,it,1))
144 END SUBROUTINE e2e_th
149 SUBROUTINE e_th2e(self, E_th, it)
153 real,
dimension(:,:,:),
pointer:: e_th
156 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
157 e => self%mem(:,:,:,self%idx%e,it,1))
160 END SUBROUTINE e_th2e
163 FUNCTION up(f,i)
RESULT (g)
164 real,
dimension(:,:,:),
intent(in):: f
165 real,
dimension(size(f,1),size(f,2),size(f,3)):: g
168 g = 0.5*(cshift(f,1,i)+f)
172 FUNCTION gas_pressure_ngz (self)
RESULT (pg)
174 real,
dimension(self%n(1),self%n(2),self%n(3)):: pg
175 integer :: l(3), u(3)
177 l = self%li; u = self%ui
178 associate(d => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%d ,self%it,1), &
179 px => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%px,self%it,1), &
180 py => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%py,self%it,1), &
181 pz => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%pz,self%it,1), &
182 bx => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%bx,self%it,1), &
183 by => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%by,self%it,1), &
184 bz => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%bz,self%it,1), &
185 e => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%e ,self%it,1))
186 if (self%gamma==1.0)
then 187 pg = d(l(1):u(1),l(2):u(2),l(3):u(3))
189 pg = (self%gamma-1.0) &
190 *(e(l(1):u(1),l(2):u(2),l(3):u(3)) -0.5*( &
191 (px(l(1):u(1),l(2):u(2),l(3):u(3))**2 + &
192 py(l(1):u(1),l(2):u(2),l(3):u(3))**2 + &
193 pz(l(1):u(1),l(2):u(2),l(3):u(3))**2) &
194 /d(l(1):u(1),l(2):u(2),l(3):u(3)) + &
195 up(bx(l(1):u(1),l(2):u(2),l(3):u(3)),1)**2 + &
196 up(by(l(1):u(1),l(2):u(2),l(3):u(3)),2)**2 + &
197 up(bz(l(1):u(1),l(2):u(2),l(3):u(3)),3)**2))
200 END FUNCTION gas_pressure_ngz
206 FUNCTION gas_temperature (self, lnd, ss)
RESULT (tmp)
208 real,
dimension(:,:,:),
pointer:: lnd, ss
209 real,
dimension(self%gn(1),self%gn(2),self%gn(3)):: tmp
211 associate(d => self%mem(:,:,:, 1,self%it,1))
212 tmp = self%gas_pressure()/d
213 if (io%verbose > 2)
then 215 error stop
"solver_t%gas_temperature: T<0" 219 END FUNCTION gas_temperature
222 FUNCTION gas_temperature_ngz (self)
RESULT (tmp)
224 real,
dimension(self%n(1),self%n(2),self%n(3)):: tmp
225 integer :: l(3), u(3)
227 l = self%li; u = self%ui
228 associate(d => self%mem(l(1):u(1),l(2):u(2),l(3):u(3), 1,self%it,1))
229 tmp = self%gas_pressure_ngz()/d
231 if (io%verbose > 2)
then 233 error stop
"solver_t%gas_temperature: T<0" 237 END FUNCTION gas_temperature_ngz
240 SUBROUTINE log_density (self, v)
242 real,
dimension(:,:,:),
pointer:: v
244 v = log(self%mem(:,:,:,self%id,self%it,1))
248 SUBROUTINE log_pressure (self, lnd, ss, v)
250 real,
dimension(:,:,:),
pointer:: lnd, ss, v
252 v = log(self%gas_pressure())
256 SUBROUTINE velocity_magnitude (self, v)
258 real,
dimension(:,:,:),
pointer:: v, d
259 real,
dimension(:,:,:,:),
pointer:: p, u
262 d => self%mem(:,:,:,self%idx%d,self%it,1)
263 p => self%mem(:,:,:,self%idx%px:self%idx%px,self%it,1)
266 v(:,:,:) = v(:,:,:) + (p(:,:,:,i)/d)**2
272 SUBROUTINE magnetic_field_magnitude (self, v)
274 real,
dimension(:,:,:),
pointer:: v
275 real,
dimension(:,:,:,:),
pointer:: b
278 associate(bx => self%mem(:,:,:,self%idx%bx,self%it,1), &
279 by => self%mem(:,:,:,self%idx%by,self%it,1), &
280 bz => self%mem(:,:,:,self%idx%bz,self%it,1))
281 v = up(bx,1)**2 + up(by,2)**2 + up(bz,3)**2
287 SUBROUTINE void (self, v)
289 real,
dimension(:,:,:),
pointer:: v
295 SUBROUTINE apply_heating (self, q)
297 real,
dimension(:,:,:):: q
301 FUNCTION gas_velocity_vector (self)
RESULT (v)
303 real(kind=KindScalarVar),
dimension(:,:,:),
pointer :: d
304 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: p
305 real(kind=KindScalarVar),
dimension(self%gn(1),self%gn(2),self%gn(3),3):: v
308 d => self%mem(:,:,:,self%idx%d,self%it,1)
309 p => self%mem(:,:,:,self%idx%px:self%idx%pz,self%it,1)
311 v(:,:,:,i) = p(:,:,:,i)/d
313 END FUNCTION gas_velocity_vector
316 FUNCTION gas_velocity_scalar (self, idir)
RESULT (v)
318 real(kind=KindScalarVar),
dimension(:,:,:),
pointer :: d
319 real(kind=KindScalarVar),
dimension(self%gn(1),self%gn(2),self%gn(3)):: v
322 d => self%mem(:,:,:,self%idx%d,self%it,1)
325 v = self%mem(:,:,:,self%idx%px,self%it,1) / d
327 v = self%mem(:,:,:,self%idx%py,self%it,1) / d
329 v = self%mem(:,:,:,self%idx%pz,self%it,1) / d
331 error stop
"solver_mod::gas_velocity_scalar:: invalid value of idir" 333 END FUNCTION gas_velocity_scalar
338 SUBROUTINE compression_magnitude (self, w)
340 real(kind=KindScalarVar),
dimension(:,:,:):: w
341 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: vx, vy, vz
343 integer,
save:: itimer=0
345 call trace%begin (
'solver_t%compression_magnitude', itimer=itimer)
346 allocate (vx(self%gn(1),self%gn(2),self%gn(3)))
347 allocate (vy(self%gn(1),self%gn(2),self%gn(3)))
348 allocate (vz(self%gn(1),self%gn(2),self%gn(3)))
349 vx = self%mem(:,:,:,self%idx%px,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
350 vy = self%mem(:,:,:,self%idx%py,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
351 vz = self%mem(:,:,:,self%idx%pz,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
352 w = max(- stagger%ddx(self%ds(1),vx) &
353 - stagger%ddy(self%ds(2),vy) &
354 - stagger%ddz(self%ds(3),vz), 0.0)
355 deallocate (vx, vy, vz)
356 call trace%end (itimer)
357 END SUBROUTINE compression_magnitude
362 SUBROUTINE vorticity_magnitude (self, w)
364 real(kind=KindScalarVar),
dimension(:,:,:):: w
365 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: vx, vy, vz
367 integer,
save:: itimer=0
369 call trace%begin (
'solver_t%vorticity_magnitude', itimer=itimer)
370 allocate (vx(self%gn(1),self%gn(2),self%gn(3)))
371 allocate (vy(self%gn(1),self%gn(2),self%gn(3)))
372 allocate (vz(self%gn(1),self%gn(2),self%gn(3)))
373 vx = self%mem(:,:,:,self%idx%px,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
374 vy = self%mem(:,:,:,self%idx%py,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
375 vz = self%mem(:,:,:,self%idx%pz,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
376 w = sqrt((stagger%ddy(self%ds(2),vz)-stagger%ddz(self%ds(3),vy))**2 &
377 + (stagger%ddz(self%ds(3),vx)-stagger%ddx(self%ds(1),vz))**2 &
378 + (stagger%ddx(self%ds(1),vy)-stagger%ddy(self%ds(2),vx))**2)
379 deallocate (vx, vy, vz)
380 call trace%end (itimer)
381 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...
6th order stagger operators, with self-test procedure
Template module for tasks.