43 REAL,
PARAMETER :: tsim = 10.0
44 REAL,
PARAMETER :: gamma = 1.4
45 REAL,
PARAMETER :: re = 1.0e+4
48 REAL,
PARAMETER :: rho0 = 1.0
49 REAL,
PARAMETER :: v0 =-0.5
50 REAL,
PARAMETER :: p0 = 2.5
51 REAL,
PARAMETER :: rho1 = 2.0
52 REAL,
PARAMETER :: v1 = 0.5
53 REAL,
PARAMETER :: p1 = p0
55 INTEGER,
PARAMETER :: mgeo = cartesian
56 INTEGER,
PARAMETER :: res = 32
57 REAL,
PARAMETER :: xyzlen= 1.0
59 INTEGER,
PARAMETER :: onum = 10
60 CHARACTER(LEN=256),
PARAMETER &
62 CHARACTER(LEN=256),
PARAMETER &
65 CLASS(
fosite),
ALLOCATABLE :: sim
66 CLASS(marray_compound),
POINTER :: pvar,pvar_init
67 INTEGER :: n,fargo,d,dt(8)
69 INTEGER,
DIMENSION(:),
ALLOCATABLE :: seed
70 CHARACTER(LEN=2),
PARAMETER :: dir_name(2) = (/
"xy",
"xz"/)
71 REAL,
DIMENSION(:,:),
ALLOCATABLE :: w
76 CALL random_seed(size=n)
79 call date_and_time(values=dt)
80 seed = sum(dt(1:8)) * (/(d-1, d=1,n)/)
83 ALLOCATE(sim,pvar,pvar_init)
88 CALL initdata(sim%Mesh, sim%Physics, sim%Timedisc, dir_name(d))
89 IF (
ASSOCIATED(sim%Timedisc%w).AND..NOT.
ALLOCATED(w))
ALLOCATE(w,source=transpose(sim%Timedisc%w))
91 CALL sim%Physics%new_statevector(pvar_init,primitive)
92 CALL transposedata(sim%Mesh,sim%Timedisc%pvar,pvar_init,dir_name(d))
95 CALL sim%Physics%new_statevector(pvar,primitive)
96 CALL transposedata(sim%Mesh,sim%Timedisc%pvar,pvar,dir_name(d))
98 CALL sim%Finalize(mpifinalize_=.false.)
103 CALL sim%InitFosite()
105 CALL setattr(sim%config,
"/datafile/filename", (trim(odir) // trim(ofname) //
"-" // dir_name(d) &
106 //
"-fargo" // achar(48+fargo) //
"_transposed"))
107 CALL setattr(sim%config,
"/mesh/fargo/direction", (1+d))
109 SELECT CASE(dir_name(d))
112 CALL setattr(sim%config,
"/mesh/decomposition", (/1,-1,1/))
115 CALL setattr(sim%config,
"/mesh/decomposition", (/1,1,-1/))
119 sim%Timedisc%pvar%data1d(:) = pvar_init%data1d(:)
120 IF (
ASSOCIATED(sim%Timedisc%w))
THEN
121 sim%Timedisc%w(:,:) = reshape(transpose(w(:,:)),shape(sim%Timedisc%w(:,:)))
123 SELECT TYPE(phys => sim%Physics)
124 TYPE IS(physics_euler)
125 CALL phys%Convert2Conservative(sim%Timedisc%pvar,sim%Timedisc%cvar)
127 CALL phys%Error(
"KHI2D::InitData",
"only non-isothermal HD supported")
134 sigma(d,fargo+1) = sqrt(sum((sim%Timedisc%pvar%data1d(:)-pvar%data1d(:))**2)/
SIZE(pvar%data1d))
136 IF (d.EQ.2.AND.fargo.EQ.2)
THEN
137 CALL sim%Finalize(mpifinalize_=.true.)
139 CALL sim%Finalize(mpifinalize_=.false.)
141 DEALLOCATE(pvar,pvar_init,sim)
142 IF (
ALLOCATED(w))
DEALLOCATE(w)
147 tap_check_small(sigma(d,1),tiny(sigma),dir_name(d) //
"-symmetry test (w/o fargo)")
148 tap_check_small(sigma(d,2),tiny(sigma),dir_name(d) //
"-symmetry test (fargo type 1)")
149 tap_check_small(sigma(d,3),tiny(sigma),dir_name(d) //
"-symmetry test (fargo type 2)")
158 CLASS(
fosite),
INTENT(INOUT) :: Sim
159 TYPE(dict_typ),
POINTER :: config
160 CHARACTER(LEN=2),
INTENT(IN) :: dir
163 TYPE(dict_typ),
POINTER :: mesh, physics, boundary, datafile, &
164 sources, timedisc, fluxes
171 "meshtype" / midpoint, &
173 "fargo/method" / fargo, &
174 "fargo/direction" / 1, &
175 "decomposition" / (/-1,1,1/), &
179 "xmin" / (-0.5*xyzlen), &
180 "xmax" / (0.5*xyzlen), &
181 "ymin" / (-0.5*xyzlen), &
182 "ymax" / (0.5*xyzlen), &
188 "meshtype" / midpoint, &
190 "fargo/method" / fargo, &
191 "fargo/direction" / 1, &
192 "decomposition" / (/-1,1,1/), &
196 "xmin" / (-0.5*xyzlen), &
197 "xmax" / (0.5*xyzlen), &
198 "zmin" / (-0.5*xyzlen), &
199 "zmax" / (0.5*xyzlen), &
203 CALL sim%Error(
"KHI2D::InitData",
"only xy- and xz-symmetry test supported")
216 "variables" / conservative, &
218 "limiter" / monocent, &
227 "western" / periodic, &
228 "eastern" / periodic, &
229 "southern" / periodic, &
230 "northern" / periodic, &
231 "bottomer" / periodic, &
232 "topper" / periodic &
238 dynvis = abs(rho0 * xyzlen * (v0-v1) / re)
239 IF (dynvis.GT.tiny(1.0))
THEN
241 "vis/stype" / viscosity, &
242 "vis/vismodel" / molecular, &
243 "vis/dynconst" / dynvis, &
244 "vis/bulkconst" / (-2./3.*dynvis), &
245 "vis/output/dynvis" / 0, &
246 "vis/output/stress" / 0, &
247 "vis/output/kinvis" / 0, &
248 "vis/output/bulkvis" / 0 &
254 "method" / modified_euler, &
258 "dtlimit" / 1.0e-10, &
259 "maxiter" / 100000, &
261 "output/energy" / 1 &
266 "fileformat" / vtk, &
268 "filename" / (trim(odir) // trim(ofname) //
"-" // dir //
"-fargo" // achar(48+fargo)), &
274 "physics" / physics, &
275 "boundary" / boundary, &
277 "timedisc" / timedisc, &
278 "datafile" / datafile &
280 IF (
ASSOCIATED(sources)) &
281 CALL setattr(config,
"sources", sources)
290 CLASS(physics_base) :: Physics
291 CLASS(mesh_base) :: Mesh
292 CLASS(timedisc_base) :: Timedisc
293 CHARACTER(LEN=2) :: dir
296 REAL,
DIMENSION(Mesh%IGMIN:Mesh%IGMAX,Mesh%JGMIN:Mesh%JGMAX,Mesh%KGMIN:Mesh%KGMAX,2) :: dv
298 INTENT(IN) :: mesh,physics,dir
299 INTENT(INOUT) :: timedisc
301 CALL random_seed(put=seed)
302 CALL random_number(dv)
305 SELECT TYPE(pvar => timedisc%pvar)
310 WHERE ((mesh%bcenter(:,:,:,2).LT.(mesh%ymin+0.25*xyzlen)).OR. &
311 (mesh%bcenter(:,:,:,2).GT.(sim%Mesh%ymin+0.75*xyzlen)))
312 pvar%density%data3d(:,:,:) = rho0
313 pvar%velocity%data4d(:,:,:,1) = v0
314 pvar%velocity%data4d(:,:,:,2) = 0.0
315 pvar%pressure%data3d(:,:,:) = p0
317 pvar%density%data3d(:,:,:) = rho1
318 pvar%velocity%data4d(:,:,:,1) = v1
319 pvar%velocity%data4d(:,:,:,2) = 0.0
320 pvar%pressure%data3d(:,:,:) = p1
324 SELECT CASE(mesh%fargo%GetType())
326 WHERE ((mesh%bcenter(mesh%IMIN,:,:,2).LT.(mesh%ymin+0.25*xyzlen)).OR. &
327 (mesh%bcenter(mesh%IMIN,:,:,2).GT.(sim%Mesh%ymin+0.75*xyzlen)))
335 WHERE ((mesh%bcenter(:,:,:,3).LT.(mesh%zmin+0.25*xyzlen)).OR. &
336 (mesh%bcenter(:,:,:,3).GT.(sim%Mesh%zmin+0.75*xyzlen)))
337 pvar%density%data3d(:,:,:) = rho0
338 pvar%velocity%data4d(:,:,:,1) = v0
339 pvar%velocity%data4d(:,:,:,2) = 0.0
340 pvar%pressure%data3d(:,:,:) = p0
342 pvar%density%data3d(:,:,:) = rho1
343 pvar%velocity%data4d(:,:,:,1) = v1
344 pvar%velocity%data4d(:,:,:,2) = 0.0
345 pvar%pressure%data3d(:,:,:) = p1
349 SELECT CASE(mesh%fargo%GetType())
351 WHERE ((mesh%bcenter(mesh%IMIN,:,:,3).LT.(mesh%zmin+0.25*xyzlen)).OR. &
352 (mesh%bcenter(mesh%IMIN,:,:,3).GT.(sim%Mesh%zmin+0.75*xyzlen)))
360 pvar%velocity%data4d(:,:,:,1:2) = pvar%velocity%data4d(:,:,:,1:2) &
361 + (dv(:,:,:,1:2)-0.5)*0.02
362 SELECT TYPE(cvar => timedisc%cvar)
364 SELECT TYPE(phys => physics)
366 CALL phys%Convert2Conservative(pvar,cvar)
367 CALL mesh%Info(
" DATA-----> initial condition: Kelvin-Helmholtz instability")
370 CALL physics%Error(
"KHI2D::InitData",
"only non-isothermal HD supported")
373 CALL physics%Error(
"KHI2D::InitData",
"only non-isothermal HD supported")
380 CLASS(mesh_base),
INTENT(IN) :: Mesh
381 CLASS(marray_compound),
INTENT(INOUT) :: pvar_in,pvar_out
382 CHARACTER(LEN=2),
INTENT(IN) :: dir
384 REAL,
ALLOCATABLE,
TARGET :: data1d(:)
386 REAL,
POINTER,
CONTIGUOUS :: tpdata2d(:,:),tpdata3d(:,:,:)
390 SELECT TYPE(pin => pvar_in)
391 TYPE IS(statevector_euler)
392 SELECT TYPE(pout => pvar_out)
393 TYPE IS(statevector_euler)
397 DO k=mesh%KGMIN,mesh%KGMAX
398 pout%density%data3d(:,:,k) = reshape(transpose(pin%density%data3d(:,:,k)), &
399 shape(pout%density%data3d(:,:,k)))
400 pout%pressure%data3d(:,:,k) = reshape(transpose(pin%pressure%data3d(:,:,k)), &
401 shape(pout%pressure%data3d(:,:,k)))
403 pout%velocity%data4d(:,:,k,1) = reshape(transpose(pin%velocity%data4d(:,:,k,2)), &
404 shape(pout%velocity%data4d(:,:,k,1)))
405 pout%velocity%data4d(:,:,k,2) = reshape(transpose(pin%velocity%data4d(:,:,k,1)), &
406 shape(pout%velocity%data4d(:,:,k,2)))
410 DO j=mesh%JGMIN,mesh%JGMAX
412 pout%density%data3d(:,j,:) = reshape(transpose(pin%density%data3d(:,j,:)), &
413 shape(pout%density%data3d(:,j,:)))
414 pout%pressure%data3d(:,j,:) = reshape(transpose(pin%pressure%data3d(:,j,:)), &
415 shape(pout%pressure%data3d(:,j,:)))
417 pout%velocity%data4d(:,j,:,1) = reshape(transpose(pin%velocity%data4d(:,j,:,2)), &
418 shape(pout%velocity%data4d(:,j,:,1)))
419 pout%velocity%data4d(:,j,:,2) = reshape(transpose(pin%velocity%data4d(:,j,:,1)), &
420 shape(pout%velocity%data4d(:,j,:,2)))
423 CALL mesh%Error(
"KHI2D::TransposeData",
"only transposition of xy- and xz-direction supported")
program khi
Kelvin-Helmholtz instability.
subroutine transposedata(Mesh, pvar_in, pvar_out, dir)
subroutine initdata(Mesh, Physics, Fluxes, Timedisc)
subroutine makeconfig(Sim, config)
physics module for 1D,2D and 3D non-isothermal Euler equations
physics module for 1D,2D and 3D isothermal Euler equations