21 procedure,
nopass:: cast2solver
28 procedure:: log_density => void
29 procedure:: log_pressure => void
30 procedure:: gas_pressure_ngz
31 procedure:: gas_temperature
32 procedure:: gas_temperature_ngz
33 procedure:: velocity_magnitude => void
34 procedure:: grav_potential => void
35 procedure:: apply_heating
36 procedure:: gas_velocity_vector
37 procedure:: gas_velocity_scalar
38 procedure:: compression_magnitude
39 procedure:: vorticity_magnitude
47 SUBROUTINE init (self)
50 call trace%begin (
'solver_t%init')
52 call self%extras_t%init
60 SUBROUTINE dealloc (self)
63 call trace%begin (
'solver_t%dealloc')
64 call self%hd_t%dealloc
66 END SUBROUTINE dealloc
71 FUNCTION cast2solver (task)
RESULT(solver)
72 class(
task_t),
pointer:: task
80 call io%abort (
'patch_t%cast: failed to cast a task to patch_t')
82 END FUNCTION cast2solver
87 SUBROUTINE update (self)
89 associate(d=>self%mem(:,:,:,self%idx%d,self%it,1))
91 call self%extras_t%pre_update
93 call self%extras_t%post_update
100 SUBROUTINE dnload (self, only)
102 integer,
optional:: only
104 call self%extras_t%dnload (only)
105 END SUBROUTINE dnload
110 SUBROUTINE p2u(self, U, it)
112 real,
dimension(:,:,:,:),
pointer:: u
115 real,
dimension(:,:,:,:),
pointer:: dd
118 associate(d => self%mem(:,:,:,self%idx%d, it,1), &
119 p => self%mem(:,:,:,self%idx%px:self%idx%pz,it,1))
121 u(:,:,:,i) = p(:,:,:,i)/d
129 SUBROUTINE u2p(self, U, it)
131 real,
dimension(:,:,:,:),
pointer:: u
134 real,
dimension(:,:,:,:),
pointer:: dd
137 associate(d => self%mem(:,:,:,self%idx%d ,it,1), &
138 p => self%mem(:,:,:,self%idx%px:self%idx%pz,it,1))
140 p(:,:,:,i) = u(:,:,:,i)*d
148 SUBROUTINE e2e_th(self, E_th, it)
152 real,
dimension(:,:,:),
pointer:: e_th
155 associate(d => self%mem(:,:,:,self%idx%d,it,1), &
156 e => self%mem(:,:,:,self%idx%e,it,1))
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 e => self%mem(:,:,:,self%idx%e,it,1))
175 END SUBROUTINE e_th2e
178 FUNCTION up(f,i)
RESULT (g)
179 real,
dimension(:,:,:),
intent(in):: f
180 real,
dimension(size(f,1),size(f,2),size(f,3)):: g
183 g = 0.5*(cshift(f,1,i)+f)
187 FUNCTION gas_pressure_ngz (self)
RESULT (pg)
189 real,
dimension(self%n(1),self%n(2),self%n(3)):: pg
190 integer :: l(3), u(3)
192 l = self%li; u = self%ui
193 associate(d => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%d ,self%it,1), &
194 px => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%px,self%it,1), &
195 py => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%py,self%it,1), &
196 pz => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%pz,self%it,1), &
197 e => self%mem(l(1):u(1),l(2):u(2),l(3):u(3),self%idx%e ,self%it,1))
198 if (self%gamma==1.0)
then 199 pg = d(l(1):u(1),l(2):u(2),l(3):u(3))
201 pg = (self%gamma-1.0) &
202 *(e(l(1):u(1),l(2):u(2),l(3):u(3)) -0.5*( &
203 (px(l(1):u(1),l(2):u(2),l(3):u(3))**2 + &
204 py(l(1):u(1),l(2):u(2),l(3):u(3))**2 + &
205 pz(l(1):u(1),l(2):u(2),l(3):u(3))**2) &
206 /d(l(1):u(1),l(2):u(2),l(3):u(3))))
209 END FUNCTION gas_pressure_ngz
215 FUNCTION gas_temperature (self, lnd, ss)
RESULT (tmp)
217 real,
dimension(:,:,:),
pointer:: lnd, ss
218 real,
dimension(self%gn(1),self%gn(2),self%gn(3)):: tmp
220 associate(d => self%mem(:,:,:, 1,self%it,1))
221 tmp = self%gas_pressure()/d
222 if (io%verbose > 2)
then 224 error stop
"solver_t%gas_temperature: T<0" 228 END FUNCTION gas_temperature
231 FUNCTION gas_temperature_ngz (self)
RESULT (tmp)
233 real,
dimension(self%n(1),self%n(2),self%n(3)):: tmp
234 integer :: l(3), u(3)
236 l = self%li; u = self%ui
237 associate(d => self%mem(l(1):u(1),l(2):u(2),l(3):u(3), 1,self%it,1))
238 tmp = self%gas_pressure_ngz()/d
240 if (io%verbose > 2)
then 242 error stop
"solver_t%gas_temperature: T<0" 246 END FUNCTION gas_temperature_ngz
249 SUBROUTINE log_density (self, v)
251 real,
dimension(:,:,:),
pointer:: v
253 v = log(self%mem(:,:,:,self%id,self%it,1))
257 SUBROUTINE log_pressure (self, lnd, ss, v)
259 real,
dimension(:,:,:),
pointer:: lnd, ss, v
261 v = log(self%gas_pressure())
265 SUBROUTINE velocity_magnitude (self, v)
267 real,
dimension(:,:,:),
pointer:: v, d
268 real,
dimension(:,:,:,:),
pointer:: p, u
271 d => self%mem(:,:,:,self%idx%d,self%it,1)
272 p => self%mem(:,:,:,self%idx%px:self%idx%px,self%it,1)
275 v(:,:,:) = v(:,:,:) + (p(:,:,:,i)/d)**2
281 SUBROUTINE void (self, v)
283 real,
dimension(:,:,:),
pointer:: v
289 SUBROUTINE apply_heating (self, q)
291 real,
dimension(:,:,:):: q
295 FUNCTION gas_velocity_vector (self)
RESULT (v)
297 real(kind=KindScalarVar),
dimension(:,:,:),
pointer :: d
298 real(kind=KindScalarVar),
dimension(:,:,:,:),
pointer:: p
299 real(kind=KindScalarVar),
dimension(self%gn(1),self%gn(2),self%gn(3),3):: v
302 d => self%mem(:,:,:,self%idx%d,self%it,1)
303 p => self%mem(:,:,:,self%idx%px:self%idx%pz,self%it,1)
305 v(:,:,:,i) = p(:,:,:,i)/d
307 END FUNCTION gas_velocity_vector
310 FUNCTION gas_velocity_scalar (self, idir)
RESULT (v)
312 real(kind=KindScalarVar),
dimension(:,:,:),
pointer :: d
313 real(kind=KindScalarVar),
dimension(self%gn(1),self%gn(2),self%gn(3)):: v
316 d => self%mem(:,:,:,self%idx%d,self%it,1)
319 v = self%mem(:,:,:,self%idx%px,self%it,1) / d
321 v = self%mem(:,:,:,self%idx%py,self%it,1) / d
323 v = self%mem(:,:,:,self%idx%pz,self%it,1) / d
325 error stop
"solver_mod::gas_velocity_scalar:: invalid value of idir" 327 END FUNCTION gas_velocity_scalar
332 SUBROUTINE compression_magnitude (self, w)
334 real(kind=KindScalarVar),
dimension(:,:,:):: w
335 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: vx, vy, vz
337 integer,
save:: itimer=0
339 call trace%begin (
'solver_t%compression_magnitude', itimer=itimer)
340 allocate (vx(self%gn(1),self%gn(2),self%gn(3)))
341 allocate (vy(self%gn(1),self%gn(2),self%gn(3)))
342 allocate (vz(self%gn(1),self%gn(2),self%gn(3)))
343 vx = self%mem(:,:,:,self%idx%px,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
344 vy = self%mem(:,:,:,self%idx%py,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
345 vz = self%mem(:,:,:,self%idx%pz,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
346 w = max(- stagger%ddx(self%ds(1),vx) &
347 - stagger%ddy(self%ds(2),vy) &
348 - stagger%ddz(self%ds(3),vz), 0.0)
349 deallocate (vx, vy, vz)
350 call trace%end (itimer)
351 END SUBROUTINE compression_magnitude
356 SUBROUTINE vorticity_magnitude (self, w)
358 real(kind=KindScalarVar),
dimension(:,:,:):: w
359 real(kind=KindScalarVar),
dimension(:,:,:),
allocatable:: vx, vy, vz
361 integer,
save:: itimer=0
363 call trace%begin (
'solver_t%vorticity_magnitude', itimer=itimer)
364 allocate (vx(self%gn(1),self%gn(2),self%gn(3)))
365 allocate (vy(self%gn(1),self%gn(2),self%gn(3)))
366 allocate (vz(self%gn(1),self%gn(2),self%gn(3)))
367 vx = self%mem(:,:,:,self%idx%px,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
368 vy = self%mem(:,:,:,self%idx%py,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
369 vz = self%mem(:,:,:,self%idx%pz,self%it,1)/self%mem(:,:,:,self%idx%d,self%it,1)
370 w = sqrt((stagger%ddy(self%ds(2),vz)-stagger%ddz(self%ds(3),vy))**2 &
371 + (stagger%ddz(self%ds(3),vx)-stagger%ddx(self%ds(1),vz))**2 &
372 + (stagger%ddx(self%ds(1),vy)-stagger%ddy(self%ds(2),vx))**2)
373 deallocate (vx, vy, vz)
374 call trace%end (itimer)
375 END SUBROUTINE vorticity_magnitude
Template module for patches, which adds pointers to memory and mesh, and number of dimensions and var...
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.