MPI-AMRVAC 3.1
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
Loading...
Searching...
No Matches
mod_hd_phys.t
Go to the documentation of this file.
1!> Hydrodynamics physics module
7 use mod_comm_lib, only: mpistop
8 implicit none
9 private
10
11 !> Whether an energy equation is used
12 logical, public, protected :: hd_energy = .true.
13
14 !> Whether thermal conduction is added
15 logical, public, protected :: hd_thermal_conduction = .false.
16 type(tc_fluid), allocatable, public :: tc_fl
17 type(te_fluid), allocatable, public :: te_fl_hd
18
19 !> Whether radiative cooling is added
20 logical, public, protected :: hd_radiative_cooling = .false.
21 type(rc_fluid), allocatable, public :: rc_fl
22
23 !> Whether dust is added
24 logical, public, protected :: hd_dust = .false.
25
26 !> Whether viscosity is added
27 logical, public, protected :: hd_viscosity = .false.
28
29 !> Whether gravity is added
30 logical, public, protected :: hd_gravity = .false.
31
32 !> Whether particles module is added
33 logical, public, protected :: hd_particles = .false.
34
35 !> Whether rotating frame is activated
36 logical, public, protected :: hd_rotating_frame = .false.
37
38 !> Whether CAK radiation line force is activated
39 logical, public, protected :: hd_cak_force = .false.
40
41 !> Number of tracer species
42 integer, public, protected :: hd_n_tracer = 0
43
44 !> Whether plasma is partially ionized
45 logical, public, protected :: hd_partial_ionization = .false.
46
47 !> Index of the density (in the w array)
48 integer, public, protected :: rho_
49
50 !> Indices of the momentum density
51 integer, allocatable, public, protected :: mom(:)
52
53 !> Indices of the momentum density for the form of better vectorization
54 integer, public, protected :: ^c&m^C_
55
56 !> Indices of the tracers
57 integer, allocatable, public, protected :: tracer(:)
58
59 !> Index of the energy density (-1 if not present)
60 integer, public, protected :: e_
61
62 !> Index of the gas pressure (-1 if not present) should equal e_
63 integer, public, protected :: p_
64
65 !> Indices of temperature
66 integer, public, protected :: te_
67
68 !> Index of the cutoff temperature for the TRAC method
69 integer, public, protected :: tcoff_
70
71 !> The adiabatic index
72 double precision, public :: hd_gamma = 5.d0/3.0d0
73
74 !> gamma minus one and its inverse
75 double precision :: gamma_1, inv_gamma_1
76
77 !> The adiabatic constant
78 double precision, public :: hd_adiab = 1.0d0
79
80 !> The small_est allowed energy
81 double precision, protected :: small_e
82
83 !> Whether TRAC method is used
84 logical, public, protected :: hd_trac = .false.
85 integer, public, protected :: hd_trac_type = 1
86
87 !> Helium abundance over Hydrogen
88 double precision, public, protected :: he_abundance=0.1d0
89 !> Ionization fraction of H
90 !> H_ion_fr = H+/(H+ + H)
91 double precision, public, protected :: h_ion_fr=1d0
92 !> Ionization fraction of He
93 !> He_ion_fr = (He2+ + He+)/(He2+ + He+ + He)
94 double precision, public, protected :: he_ion_fr=1d0
95 !> Ratio of number He2+ / number He+ + He2+
96 !> He_ion_fr2 = He2+/(He2+ + He+)
97 double precision, public, protected :: he_ion_fr2=1d0
98 ! used for eq of state when it is not defined by units,
99 ! the units do not contain terms related to ionization fraction
100 ! and it is p = RR * rho * T
101 double precision, public, protected :: rr=1d0
102 ! remove the below flag and assume default value = .false.
103 ! when eq state properly implemented everywhere
104 ! and not anymore through units
105 logical, public, protected :: eq_state_units = .true.
106
107 procedure(sub_get_pthermal), pointer :: hd_get_rfactor => null()
108 ! Public methods
109 public :: hd_phys_init
110 public :: hd_kin_en
111 public :: hd_get_pthermal
112 public :: hd_get_csound2
113 public :: hd_to_conserved
114 public :: hd_to_primitive
115 public :: hd_check_params
116 public :: hd_check_w
117
118contains
119
120 !> Read this module's parameters from a file
121 subroutine hd_read_params(files)
123 character(len=*), intent(in) :: files(:)
124 integer :: n
125
126 namelist /hd_list/ hd_energy, hd_n_tracer, hd_gamma, hd_adiab, &
131
132 do n = 1, size(files)
133 open(unitpar, file=trim(files(n)), status="old")
134 read(unitpar, hd_list, end=111)
135111 close(unitpar)
136 end do
137
138 end subroutine hd_read_params
139
140 !> Write this module's parameters to a snapsoht
141 subroutine hd_write_info(fh)
143 integer, intent(in) :: fh
144 integer, parameter :: n_par = 1
145 double precision :: values(n_par)
146 character(len=name_len) :: names(n_par)
147 integer, dimension(MPI_STATUS_SIZE) :: st
148 integer :: er
149
150 call mpi_file_write(fh, n_par, 1, mpi_integer, st, er)
151
152 names(1) = "gamma"
153 values(1) = hd_gamma
154 call mpi_file_write(fh, values, n_par, mpi_double_precision, st, er)
155 call mpi_file_write(fh, names, n_par * name_len, mpi_character, st, er)
156 end subroutine hd_write_info
157
158 !> Initialize the module
159 subroutine hd_phys_init()
163 use mod_dust, only: dust_init
165 use mod_gravity, only: gravity_init
168 use mod_cak_force, only: cak_init
173
174 integer :: itr, idir
175
176 call hd_read_params(par_files)
177
178 physics_type = "hd"
179 phys_energy = hd_energy
180 phys_total_energy = hd_energy
181 phys_internal_e = .false.
182 phys_gamma = hd_gamma
183 phys_partial_ionization=hd_partial_ionization
184
186 if(phys_trac) then
187 if(ndim .eq. 1) then
188 if(hd_trac_type .gt. 2) then
190 if(mype==0) write(*,*) 'WARNING: set hd_trac_type=1'
191 end if
193 else
194 phys_trac=.false.
195 if(mype==0) write(*,*) 'WARNING: set hd_trac=F when ndim>=2'
196 end if
197 end if
198
199 ! set default gamma for polytropic/isothermal process
200 if(.not.hd_energy) then
201 if(hd_thermal_conduction) then
203 if(mype==0) write(*,*) 'WARNING: set hd_thermal_conduction=F when hd_energy=F'
204 end if
205 if(hd_radiative_cooling) then
207 if(mype==0) write(*,*) 'WARNING: set hd_radiative_cooling=F when hd_energy=F'
208 end if
209 end if
210 if(.not.eq_state_units) then
211 if(hd_partial_ionization) then
213 if(mype==0) write(*,*) 'WARNING: set hd_partial_ionization=F when eq_state_units=F'
214 end if
215 end if
217
218 allocate(start_indices(number_species),stop_indices(number_species))
219
220 ! set the index of the first flux variable for species 1
221 start_indices(1)=1
222 ! Determine flux variables
223 rho_ = var_set_rho()
224
225 allocate(mom(ndir))
226 mom(:) = var_set_momentum(ndir)
227 m^c_=mom(^c);
228
229 ! Set index of energy variable
230 if (hd_energy) then
231 e_ = var_set_energy()
232 p_ = e_
233 else
234 e_ = -1
235 p_ = -1
236 end if
237
238 phys_get_dt => hd_get_dt
239 phys_get_cmax => hd_get_cmax
240 phys_get_a2max => hd_get_a2max
241 phys_get_tcutoff => hd_get_tcutoff
242 phys_get_cbounds => hd_get_cbounds
243 phys_get_flux => hd_get_flux
244 phys_add_source_geom => hd_add_source_geom
245 phys_add_source => hd_add_source
246 phys_to_conserved => hd_to_conserved
247 phys_to_primitive => hd_to_primitive
248 phys_check_params => hd_check_params
249 phys_check_w => hd_check_w
250 phys_get_pthermal => hd_get_pthermal
251 phys_get_v => hd_get_v
252 phys_get_rho => hd_get_rho
253 phys_write_info => hd_write_info
254 phys_handle_small_values => hd_handle_small_values
255
256 ! derive units from basic units
257 call hd_physical_units()
258
259 if (hd_dust) then
260 call dust_init(rho_, mom(:), e_)
261 endif
262
263 allocate(tracer(hd_n_tracer))
264
265 ! Set starting index of tracers
266 do itr = 1, hd_n_tracer
267 tracer(itr) = var_set_fluxvar("trc", "trp", itr, need_bc=.false.)
268 end do
269
270 ! set number of variables which need update ghostcells
271 nwgc=nwflux+nwaux
272
273 ! set the index of the last flux variable for species 1
274 stop_indices(1)=nwflux
275
276 ! set temperature as an auxiliary variable to get ionization degree
277 if(hd_partial_ionization) then
278 te_ = var_set_auxvar('Te','Te')
279 else
280 te_ = -1
281 end if
282
283 if(hd_trac) then
284 tcoff_ = var_set_wextra()
285 iw_tcoff=tcoff_
286 else
287 tcoff_ = -1
288 end if
289
290 ! choose Rfactor in ideal gas law
291 if(hd_partial_ionization) then
292 hd_get_rfactor=>rfactor_from_temperature_ionization
293 phys_update_temperature => hd_update_temperature
294 else if(associated(usr_rfactor)) then
295 hd_get_rfactor=>usr_rfactor
296 else
297 hd_get_rfactor=>rfactor_from_constant_ionization
298 end if
299
300 ! initialize thermal conduction module
301 if (hd_thermal_conduction) then
302 if (.not. hd_energy) &
303 call mpistop("thermal conduction needs hd_energy=T")
304
305 call sts_init()
307
308 allocate(tc_fl)
309 call tc_get_hd_params(tc_fl,tc_params_read_hd)
310 call add_sts_method(hd_get_tc_dt_hd,hd_sts_set_source_tc_hd,e_,1,e_,1,.false.)
311 call set_conversion_methods_to_head(hd_e_to_ei, hd_ei_to_e)
312 call set_error_handling_to_head(hd_tc_handle_small_e)
313 tc_fl%get_temperature_from_conserved => hd_get_temperature_from_etot
314 tc_fl%get_temperature_from_eint => hd_get_temperature_from_eint
315 tc_fl%get_rho => hd_get_rho
316 tc_fl%e_ = e_
317 end if
318
319 ! Initialize radiative cooling module
320 if (hd_radiative_cooling) then
321 if (.not. hd_energy) &
322 call mpistop("radiative cooling needs hd_energy=T")
324 allocate(rc_fl)
325 call radiative_cooling_init(rc_fl,rc_params_read)
326 rc_fl%get_rho => hd_get_rho
327 rc_fl%get_pthermal => hd_get_pthermal
328 rc_fl%get_var_Rfactor => hd_get_rfactor
329 rc_fl%e_ = e_
330 rc_fl%Tcoff_ = tcoff_
331 end if
332 allocate(te_fl_hd)
333 te_fl_hd%get_rho=> hd_get_rho
334 te_fl_hd%get_pthermal=> hd_get_pthermal
335 te_fl_hd%get_var_Rfactor => hd_get_rfactor
336{^ifthreed
337 phys_te_images => hd_te_images
338}
339 ! Initialize viscosity module
340 if (hd_viscosity) call viscosity_init(phys_wider_stencil)
341
342 ! Initialize gravity module
343 if (hd_gravity) call gravity_init()
344
345 ! Initialize rotating_frame module
347
348 ! Initialize CAK radiation force module
350
351 ! Initialize particles module
352 if (hd_particles) then
353 call particles_init()
354 end if
355
356 ! Check whether custom flux types have been defined
357 if (.not. allocated(flux_type)) then
358 allocate(flux_type(ndir, nw))
359 flux_type = flux_default
360 else if (any(shape(flux_type) /= [ndir, nw])) then
361 call mpistop("phys_check error: flux_type has wrong shape")
362 end if
363
364 nvector = 1 ! No. vector vars
365 allocate(iw_vector(nvector))
366 iw_vector(1) = mom(1) - 1
367 ! initialize ionization degree table
369
370 end subroutine hd_phys_init
371
372{^ifthreed
373 subroutine hd_te_images
376 select case(convert_type)
377 case('EIvtiCCmpi','EIvtuCCmpi')
379 case('ESvtiCCmpi','ESvtuCCmpi')
381 case('SIvtiCCmpi','SIvtuCCmpi')
383 case('WIvtiCCmpi','WIvtuCCmpi')
385 case default
386 call mpistop("Error in synthesize emission: Unknown convert_type")
387 end select
388 end subroutine hd_te_images
389}
390!!start th cond
391 ! wrappers for STS functions in thermal_conductivity module
392 ! which take as argument the tc_fluid (defined in the physics module)
393 subroutine hd_sts_set_source_tc_hd(ixI^L,ixO^L,w,x,wres,fix_conserve_at_step,my_dt,igrid,nflux)
397 integer, intent(in) :: ixi^l, ixo^l, igrid, nflux
398 double precision, intent(in) :: x(ixi^s,1:ndim)
399 double precision, intent(inout) :: wres(ixi^s,1:nw), w(ixi^s,1:nw)
400 double precision, intent(in) :: my_dt
401 logical, intent(in) :: fix_conserve_at_step
402 call sts_set_source_tc_hd(ixi^l,ixo^l,w,x,wres,fix_conserve_at_step,my_dt,igrid,nflux,tc_fl)
403 end subroutine hd_sts_set_source_tc_hd
404
405 function hd_get_tc_dt_hd(w,ixI^L,ixO^L,dx^D,x) result(dtnew)
406 !Check diffusion time limit dt < dx_i**2/((gamma-1)*tc_k_para_i/rho)
407 !where tc_k_para_i=tc_k_para*B_i**2/B**2
408 !and T=p/rho
411
412 integer, intent(in) :: ixi^l, ixo^l
413 double precision, intent(in) :: dx^d, x(ixi^s,1:ndim)
414 double precision, intent(in) :: w(ixi^s,1:nw)
415 double precision :: dtnew
416
417 dtnew=get_tc_dt_hd(w,ixi^l,ixo^l,dx^d,x,tc_fl)
418 end function hd_get_tc_dt_hd
419
420 subroutine hd_tc_handle_small_e(w, x, ixI^L, ixO^L, step)
421 ! move this in a different routine as in mhd if needed in more places
424
425 integer, intent(in) :: ixi^l,ixo^l
426 double precision, intent(inout) :: w(ixi^s,1:nw)
427 double precision, intent(in) :: x(ixi^s,1:ndim)
428 integer, intent(in) :: step
429
430 integer :: idir
431 logical :: flag(ixi^s,1:nw)
432 character(len=140) :: error_msg
433
434 flag=.false.
435 where(w(ixo^s,e_)<small_e) flag(ixo^s,e_)=.true.
436 if(any(flag(ixo^s,e_))) then
437 select case (small_values_method)
438 case ("replace")
439 where(flag(ixo^s,e_)) w(ixo^s,e_)=small_e
440 case ("average")
441 call small_values_average(ixi^l, ixo^l, w, x, flag, e_)
442 case default
443 ! small values error shows primitive variables
444 w(ixo^s,e_)=w(ixo^s,e_)*(hd_gamma - 1.0d0)
445 do idir = 1, ndir
446 w(ixo^s, iw_mom(idir)) = w(ixo^s, iw_mom(idir))/w(ixo^s,rho_)
447 end do
448 write(error_msg,"(a,i3)") "Thermal conduction step ", step
449 call small_values_error(w, x, ixi^l, ixo^l, flag, error_msg)
450 end select
451 end if
452 end subroutine hd_tc_handle_small_e
453
454 ! fill in tc_fluid fields from namelist
455 subroutine tc_params_read_hd(fl)
457 type(tc_fluid), intent(inout) :: fl
458 integer :: n
459 logical :: tc_saturate=.false.
460 double precision :: tc_k_para=0d0
461
462 namelist /tc_list/ tc_saturate, tc_k_para
463
464 do n = 1, size(par_files)
465 open(unitpar, file=trim(par_files(n)), status="old")
466 read(unitpar, tc_list, end=111)
467111 close(unitpar)
468 end do
469 fl%tc_saturate = tc_saturate
470 fl%tc_k_para = tc_k_para
471
472 end subroutine tc_params_read_hd
473
474 subroutine hd_get_rho(w,x,ixI^L,ixO^L,rho)
476 integer, intent(in) :: ixi^l, ixo^l
477 double precision, intent(in) :: w(ixi^s,1:nw),x(ixi^s,1:ndim)
478 double precision, intent(out) :: rho(ixi^s)
479
480 rho(ixo^s) = w(ixo^s,rho_)
481
482 end subroutine hd_get_rho
483
484!!end th cond
485!!rad cool
486 subroutine rc_params_read(fl)
488 use mod_constants, only: bigdouble
489 use mod_basic_types, only: std_len
490 type(rc_fluid), intent(inout) :: fl
491 integer :: n
492 ! list parameters
493 integer :: ncool = 4000
494 double precision :: cfrac=0.1d0
495
496 !> Name of cooling curve
497 character(len=std_len) :: coolcurve='JCcorona'
498
499 !> Name of cooling method
500 character(len=std_len) :: coolmethod='exact'
501
502 !> Fixed temperature not lower than tlow
503 logical :: tfix=.false.
504
505 !> Lower limit of temperature
506 double precision :: tlow=bigdouble
507
508 !> Add cooling source in a split way (.true.) or un-split way (.false.)
509 logical :: rc_split=.false.
510
511
512 namelist /rc_list/ coolcurve, coolmethod, ncool, cfrac, tlow, tfix, rc_split
513
514 do n = 1, size(par_files)
515 open(unitpar, file=trim(par_files(n)), status="old")
516 read(unitpar, rc_list, end=111)
517111 close(unitpar)
518 end do
519
520 fl%ncool=ncool
521 fl%coolcurve=coolcurve
522 fl%coolmethod=coolmethod
523 fl%tlow=tlow
524 fl%Tfix=tfix
525 fl%rc_split=rc_split
526 fl%cfrac=cfrac
527 end subroutine rc_params_read
528!! end rad cool
529
533
534 if (.not. hd_energy) then
535 if (hd_gamma <= 0.0d0) call mpistop ("Error: hd_gamma <= 0")
536 if (hd_adiab < 0.0d0) call mpistop ("Error: hd_adiab < 0")
538 else
539 if (hd_gamma <= 0.0d0 .or. hd_gamma == 1.0d0) &
540 call mpistop ("Error: hd_gamma <= 0 or hd_gamma == 1.0")
541 small_e = small_pressure/(hd_gamma - 1.0d0)
542 inv_gamma_1=1.d0/(hd_gamma-1.d0)
543 end if
544
545 if (hd_dust) call dust_check_params()
546 if(use_imex_scheme) then
547 ! implicit dust update
548 phys_implicit_update => dust_implicit_update
549 phys_evaluate_implicit => dust_evaluate_implicit
550 endif
551
552 end subroutine hd_check_params
553
554 subroutine hd_physical_units
556 double precision :: mp,kb
557 double precision :: a,b
558 ! Derive scaling units
559 if(si_unit) then
560 mp=mp_si
561 kb=kb_si
562 else
563 mp=mp_cgs
564 kb=kb_cgs
565 end if
566 if(eq_state_units) then
567 a=1d0+4d0*he_abundance
568 if(hd_partial_ionization) then
569 b=1d0+h_ion_fr+he_abundance*(he_ion_fr*(he_ion_fr2+1d0)+1d0)
570 else
571 b=2d0+3d0*he_abundance
572 end if
573 rr=1d0
574 else
575 a=1d0
576 b=1d0
577 rr=(1d0+h_ion_fr+he_abundance*(he_ion_fr*(he_ion_fr2+1d0)+1d0))/(1d0+4d0*he_abundance)
578 end if
579 if(unit_density/=1.d0 .or. unit_numberdensity/=1.d0) then
580 if(unit_density/=1.d0) then
582 else if(unit_numberdensity/=1.d0) then
584 end if
585 if(unit_temperature/=1.d0) then
588 if(unit_length/=1.d0) then
590 else if(unit_time/=1.d0) then
592 end if
593 else if(unit_pressure/=1.d0) then
596 if(unit_length/=1.d0) then
598 else if(unit_time/=1.d0) then
600 end if
601 else if(unit_velocity/=1.d0) then
604 if(unit_length/=1.d0) then
606 else if(unit_time/=1.d0) then
608 end if
609 else if(unit_time/=1.d0) then
613 end if
614 else if(unit_temperature/=1.d0) then
615 ! units of temperature and velocity are dependent
616 if(unit_pressure/=1.d0) then
620 if(unit_length/=1.d0) then
622 else if(unit_time/=1.d0) then
624 end if
625 end if
626 else if(unit_pressure/=1.d0) then
627 if(unit_velocity/=1.d0) then
631 if(unit_length/=1.d0) then
633 else if(unit_time/=1.d0) then
635 end if
636 else if(unit_time/=0.d0) then
641 end if
642 end if
644
645 end subroutine hd_physical_units
646
647 !> Returns logical argument flag where values are ok
648 subroutine hd_check_w(primitive, ixI^L, ixO^L, w, flag)
650 use mod_dust, only: dust_check_w
651
652 logical, intent(in) :: primitive
653 integer, intent(in) :: ixi^l, ixo^l
654 double precision, intent(in) :: w(ixi^s, nw)
655 logical, intent(inout) :: flag(ixi^s,1:nw)
656 double precision :: tmp(ixi^s)
657
658 flag=.false.
659
660 if (hd_energy) then
661 if (primitive) then
662 where(w(ixo^s, e_) < small_pressure) flag(ixo^s,e_) = .true.
663 else
664 tmp(ixo^s)=(hd_gamma-1.0d0)*(w(ixo^s,e_)-&
665 half*(^c&w(ixo^s,m^c_)**2+)/w(ixo^s,rho_))
666 where(tmp(ixo^s) < small_pressure) flag(ixo^s,e_) = .true.
667 endif
668 end if
669
670 where(w(ixo^s, rho_) < small_density) flag(ixo^s,rho_) = .true.
671
672 if(hd_dust) call dust_check_w(ixi^l,ixo^l,w,flag)
673
674 end subroutine hd_check_w
675
676 !> Transform primitive variables into conservative ones
677 subroutine hd_to_conserved(ixI^L, ixO^L, w, x)
679 use mod_dust, only: dust_to_conserved
680 integer, intent(in) :: ixi^l, ixo^l
681 double precision, intent(inout) :: w(ixi^s, nw)
682 double precision, intent(in) :: x(ixi^s, 1:ndim)
683
684 integer :: ix^d
685
686 {do ix^db=ixomin^db,ixomax^db\}
687 if (hd_energy) then
688 ! Calculate total energy from pressure and kinetic energy
689 w(ix^d,e_)=w(ix^d, e_)*inv_gamma_1+&
690 half*(^c&w(ix^d,m^c_)**2+)*w(ix^d,rho_)
691 end if
692 ! Convert velocity to momentum
693 ^c&w(ix^d,m^c_)=w(ix^d,rho_)*w(ix^d,m^c_)\
694 {end do\}
695
696 if (hd_dust) then
697 call dust_to_conserved(ixi^l, ixo^l, w, x)
698 end if
699
700 end subroutine hd_to_conserved
701
702 !> Transform conservative variables into primitive ones
703 subroutine hd_to_primitive(ixI^L, ixO^L, w, x)
705 use mod_dust, only: dust_to_primitive
706 integer, intent(in) :: ixi^l, ixo^l
707 double precision, intent(inout) :: w(ixi^s, nw)
708 double precision, intent(in) :: x(ixi^s, 1:ndim)
709
710 double precision :: inv_rho
711 integer :: ix^d
712
713 if (fix_small_values) then
714 call hd_handle_small_values(.false., w, x, ixi^l, ixo^l, 'hd_to_primitive')
715 end if
716
717 {do ix^db=ixomin^db,ixomax^db\}
718 inv_rho = 1.d0/w(ix^d,rho_)
719 ! Convert momentum to velocity
720 ^c&w(ix^d,m^c_)=w(ix^d,m^c_)*inv_rho\
721 ! Calculate pressure = (gamma-1) * (e-ek)
722 if(hd_energy) then
723 ! Compute pressure
724 w(ix^d,p_)=(hd_gamma-1.d0)*(w(ix^d,e_)&
725 -half*w(ix^d,rho_)*(^c&w(ix^d,m^c_)**2+))
726 end if
727 {end do\}
728
729 ! Convert dust momentum to dust velocity
730 if (hd_dust) then
731 call dust_to_primitive(ixi^l, ixo^l, w, x)
732 end if
733
734 end subroutine hd_to_primitive
735
736 !> Transform internal energy to total energy
737 subroutine hd_ei_to_e(ixI^L,ixO^L,w,x)
739 integer, intent(in) :: ixi^l, ixo^l
740 double precision, intent(inout) :: w(ixi^s, nw)
741 double precision, intent(in) :: x(ixi^s, 1:ndim)
742
743 ! Calculate total energy from internal and kinetic energy
744 w(ixo^s,e_)=w(ixo^s,e_)+half*(^c&w(ixo^s,m^c_)**2+)/w(ixo^s,rho_)
745
746 end subroutine hd_ei_to_e
747
748 !> Transform total energy to internal energy
749 subroutine hd_e_to_ei(ixI^L,ixO^L,w,x)
751 integer, intent(in) :: ixi^l, ixo^l
752 double precision, intent(inout) :: w(ixi^s, nw)
753 double precision, intent(in) :: x(ixi^s, 1:ndim)
754
755 ! Calculate ei = e - ek
756 w(ixo^s,e_)=w(ixo^s,e_)-half*(^c&w(ixo^s,m^c_)**2+)/w(ixo^s,rho_)
757
758 end subroutine hd_e_to_ei
759
760 !> Calculate v_i = m_i / rho within ixO^L
761 subroutine hd_get_v_idim(w, x, ixI^L, ixO^L, idim, v)
763 integer, intent(in) :: ixi^l, ixo^l, idim
764 double precision, intent(in) :: w(ixi^s, nw), x(ixi^s, 1:ndim)
765 double precision, intent(out) :: v(ixi^s)
766
767 v(ixo^s) = w(ixo^s, mom(idim)) / w(ixo^s, rho_)
768 end subroutine hd_get_v_idim
769
770 !> Calculate velocity vector v_i = m_i / rho within ixO^L
771 subroutine hd_get_v(w,x,ixI^L,ixO^L,v)
773
774 integer, intent(in) :: ixi^l, ixo^l
775 double precision, intent(in) :: w(ixi^s,nw), x(ixi^s,1:^nd)
776 double precision, intent(out) :: v(ixi^s,1:ndir)
777
778 integer :: idir
779
780 do idir=1,ndir
781 v(ixo^s,idir) = w(ixo^s, mom(idir)) / w(ixo^s, rho_)
782 end do
783
784 end subroutine hd_get_v
785
786 !> Calculate cmax_idim = csound + abs(v_idim) within ixO^L
787 subroutine hd_get_cmax(w, x, ixI^L, ixO^L, idim, cmax)
791
792 integer, intent(in) :: ixi^l, ixo^l, idim
793 ! w in primitive form
794 double precision, intent(in) :: w(ixi^s, nw), x(ixi^s, 1:ndim)
795 double precision, intent(inout) :: cmax(ixi^s)
796
797 if(hd_energy) then
798 cmax(ixo^s)=dabs(w(ixo^s,mom(idim)))+dsqrt(hd_gamma*w(ixo^s,p_)/w(ixo^s,rho_))
799 else
800 if (.not. associated(usr_set_pthermal)) then
801 cmax(ixo^s) = hd_adiab * w(ixo^s, rho_)**hd_gamma
802 else
803 call usr_set_pthermal(w,x,ixi^l,ixo^l,cmax)
804 end if
805 cmax(ixo^s)=dabs(w(ixo^s,mom(idim)))+dsqrt(hd_gamma*cmax(ixo^s)/w(ixo^s,rho_))
806 end if
807
808 if (hd_dust) then
809 call dust_get_cmax_prim(w, x, ixi^l, ixo^l, idim, cmax)
810 end if
811 end subroutine hd_get_cmax
812
813 subroutine hd_get_a2max(w,x,ixI^L,ixO^L,a2max)
815
816 integer, intent(in) :: ixi^l, ixo^l
817 double precision, intent(in) :: w(ixi^s, nw), x(ixi^s,1:ndim)
818 double precision, intent(inout) :: a2max(ndim)
819 double precision :: a2(ixi^s,ndim,nw)
820 integer :: gxo^l,hxo^l,jxo^l,kxo^l,i,j
821
822 a2=zero
823 do i = 1,ndim
824 !> 4th order
825 hxo^l=ixo^l-kr(i,^d);
826 gxo^l=hxo^l-kr(i,^d);
827 jxo^l=ixo^l+kr(i,^d);
828 kxo^l=jxo^l+kr(i,^d);
829 a2(ixo^s,i,1:nw)=dabs(-w(kxo^s,1:nw)+16.d0*w(jxo^s,1:nw)&
830 -30.d0*w(ixo^s,1:nw)+16.d0*w(hxo^s,1:nw)-w(gxo^s,1:nw))
831 a2max(i)=maxval(a2(ixo^s,i,1:nw))/12.d0/dxlevel(i)**2
832 end do
833 end subroutine hd_get_a2max
834
835 !> get adaptive cutoff temperature for TRAC (Johnston 2019 ApJL, 873, L22)
836 subroutine hd_get_tcutoff(ixI^L,ixO^L,w,x,tco_local,Tmax_local)
838 integer, intent(in) :: ixi^l,ixo^l
839 double precision, intent(in) :: x(ixi^s,1:ndim)
840 ! in primitive form
841 double precision, intent(inout) :: w(ixi^s,1:nw)
842 double precision, intent(out) :: tco_local, tmax_local
843
844 double precision, parameter :: trac_delta=0.25d0
845 double precision :: tmp1(ixi^s),te(ixi^s),lts(ixi^s)
846 double precision :: ltr(ixi^s),ltrc,ltrp,tcoff(ixi^s)
847 integer :: jxo^l,hxo^l
848 integer :: jxp^l,hxp^l,ixp^l
849 logical :: lrlt(ixi^s)
850
851 {^ifoned
852 call hd_get_rfactor(w,x,ixi^l,ixi^l,te)
853 te(ixi^s)=w(ixi^s,p_)/(te(ixi^s)*w(ixi^s,rho_))
854
855 tco_local=zero
856 tmax_local=maxval(te(ixo^s))
857 select case(hd_trac_type)
858 case(0)
859 w(ixi^s,tcoff_)=3.d5/unit_temperature
860 case(1)
861 hxo^l=ixo^l-1;
862 jxo^l=ixo^l+1;
863 lts(ixo^s)=0.5d0*dabs(te(jxo^s)-te(hxo^s))/te(ixo^s)
864 lrlt=.false.
865 where(lts(ixo^s) > trac_delta)
866 lrlt(ixo^s)=.true.
867 end where
868 if(any(lrlt(ixo^s))) then
869 tco_local=maxval(te(ixo^s), mask=lrlt(ixo^s))
870 end if
871 case(2)
872 !> iijima et al. 2021, LTRAC method
873 ltrc=1.5d0
874 ltrp=2.5d0
875 ixp^l=ixo^l^ladd1;
876 hxo^l=ixo^l-1;
877 jxo^l=ixo^l+1;
878 hxp^l=ixp^l-1;
879 jxp^l=ixp^l+1;
880 lts(ixp^s)=0.5d0*abs(te(jxp^s)-te(hxp^s))/te(ixp^s)
881 ltr(ixp^s)=max(one, (exp(lts(ixp^s))/ltrc)**ltrp)
882 w(ixo^s,tcoff_)=te(ixo^s)*&
883 (0.25*(ltr(jxo^s)+two*ltr(ixo^s)+ltr(hxo^s)))**0.4d0
884 case default
885 call mpistop("mhd_trac_type not allowed for 1D simulation")
886 end select
887 }
888 end subroutine hd_get_tcutoff
889
890 !> Calculate cmax_idim = csound + abs(v_idim) within ixO^L
891 subroutine hd_get_cbounds(wLC, wRC, wLp, wRp, x, ixI^L, ixO^L, idim,Hspeed,cmax, cmin)
893 use mod_dust, only: dust_get_cmax
894 use mod_variables
895
896 integer, intent(in) :: ixi^l, ixo^l, idim
897 ! conservative left and right status
898 double precision, intent(in) :: wlc(ixi^s, nw), wrc(ixi^s, nw)
899 ! primitive left and right status
900 double precision, intent(in) :: wlp(ixi^s, nw), wrp(ixi^s, nw)
901 double precision, intent(in) :: x(ixi^s, 1:ndim)
902 double precision, intent(inout) :: cmax(ixi^s,1:number_species)
903 double precision, intent(inout), optional :: cmin(ixi^s,1:number_species)
904 double precision, intent(in) :: hspeed(ixi^s,1:number_species)
905
906 double precision :: wmean(ixi^s,nw)
907 double precision, dimension(ixI^S) :: umean, dmean, csoundl, csoundr, tmp1,tmp2,tmp3
908 integer :: ix^d
909
910 select case(boundspeed)
911 case (1)
912 ! This implements formula (10.52) from "Riemann Solvers and Numerical
913 ! Methods for Fluid Dynamics" by Toro.
914
915 tmp1(ixo^s)=dsqrt(wlp(ixo^s,rho_))
916 tmp2(ixo^s)=dsqrt(wrp(ixo^s,rho_))
917 tmp3(ixo^s)=1.d0/(dsqrt(wlp(ixo^s,rho_))+dsqrt(wrp(ixo^s,rho_)))
918 umean(ixo^s)=(wlp(ixo^s,mom(idim))*tmp1(ixo^s)+wrp(ixo^s,mom(idim))*tmp2(ixo^s))*tmp3(ixo^s)
919
920 if(hd_energy) then
921 csoundl(ixo^s)=hd_gamma*wlp(ixo^s,p_)/wlp(ixo^s,rho_)
922 csoundr(ixo^s)=hd_gamma*wrp(ixo^s,p_)/wrp(ixo^s,rho_)
923 else
924 call hd_get_csound2(wlc,x,ixi^l,ixo^l,csoundl)
925 call hd_get_csound2(wrc,x,ixi^l,ixo^l,csoundr)
926 end if
927
928 dmean(ixo^s) = (tmp1(ixo^s)*csoundl(ixo^s)+tmp2(ixo^s)*csoundr(ixo^s)) * &
929 tmp3(ixo^s) + 0.5d0*tmp1(ixo^s)*tmp2(ixo^s)*tmp3(ixo^s)**2 * &
930 (wrp(ixo^s,mom(idim))-wlp(ixo^s,mom(idim)))**2
931
932 dmean(ixo^s)=dsqrt(dmean(ixo^s))
933 if(present(cmin)) then
934 cmin(ixo^s,1)=umean(ixo^s)-dmean(ixo^s)
935 cmax(ixo^s,1)=umean(ixo^s)+dmean(ixo^s)
936 if(h_correction) then
937 {do ix^db=ixomin^db,ixomax^db\}
938 cmin(ix^d,1)=sign(one,cmin(ix^d,1))*max(abs(cmin(ix^d,1)),hspeed(ix^d,1))
939 cmax(ix^d,1)=sign(one,cmax(ix^d,1))*max(abs(cmax(ix^d,1)),hspeed(ix^d,1))
940 {end do\}
941 end if
942 else
943 cmax(ixo^s,1)=dabs(umean(ixo^s))+dmean(ixo^s)
944 end if
945
946 if (hd_dust) then
947 wmean(ixo^s,1:nwflux)=0.5d0*(wlc(ixo^s,1:nwflux)+wrc(ixo^s,1:nwflux))
948 call dust_get_cmax(wmean, x, ixi^l, ixo^l, idim, cmax, cmin)
949 end if
950
951 case (2)
952 wmean(ixo^s,1:nwflux)=0.5d0*(wlc(ixo^s,1:nwflux)+wrc(ixo^s,1:nwflux))
953 tmp1(ixo^s)=wmean(ixo^s,mom(idim))/wmean(ixo^s,rho_)
954 call hd_get_csound2(wmean,x,ixi^l,ixo^l,csoundr)
955 csoundr(ixo^s) = dsqrt(csoundr(ixo^s))
956
957 if(present(cmin)) then
958 cmax(ixo^s,1)=max(tmp1(ixo^s)+csoundr(ixo^s),zero)
959 cmin(ixo^s,1)=min(tmp1(ixo^s)-csoundr(ixo^s),zero)
960 if(h_correction) then
961 {do ix^db=ixomin^db,ixomax^db\}
962 cmin(ix^d,1)=sign(one,cmin(ix^d,1))*max(abs(cmin(ix^d,1)),hspeed(ix^d,1))
963 cmax(ix^d,1)=sign(one,cmax(ix^d,1))*max(abs(cmax(ix^d,1)),hspeed(ix^d,1))
964 {end do\}
965 end if
966 else
967 cmax(ixo^s,1)=dabs(tmp1(ixo^s))+csoundr(ixo^s)
968 end if
969
970 if (hd_dust) then
971 call dust_get_cmax(wmean, x, ixi^l, ixo^l, idim, cmax, cmin)
972 end if
973 case (3)
974 ! Miyoshi 2005 JCP 208, 315 equation (67)
975 if(hd_energy) then
976 csoundl(ixo^s)=hd_gamma*wlp(ixo^s,p_)/wlp(ixo^s,rho_)
977 csoundr(ixo^s)=hd_gamma*wrp(ixo^s,p_)/wrp(ixo^s,rho_)
978 else
979 call hd_get_csound2(wlc,x,ixi^l,ixo^l,csoundl)
980 call hd_get_csound2(wrc,x,ixi^l,ixo^l,csoundr)
981 end if
982 csoundl(ixo^s)=max(dsqrt(csoundl(ixo^s)),dsqrt(csoundr(ixo^s)))
983 if(present(cmin)) then
984 cmin(ixo^s,1)=min(wlp(ixo^s,mom(idim)),wrp(ixo^s,mom(idim)))-csoundl(ixo^s)
985 cmax(ixo^s,1)=max(wlp(ixo^s,mom(idim)),wrp(ixo^s,mom(idim)))+csoundl(ixo^s)
986 if(h_correction) then
987 {do ix^db=ixomin^db,ixomax^db\}
988 cmin(ix^d,1)=sign(one,cmin(ix^d,1))*max(abs(cmin(ix^d,1)),hspeed(ix^d,1))
989 cmax(ix^d,1)=sign(one,cmax(ix^d,1))*max(abs(cmax(ix^d,1)),hspeed(ix^d,1))
990 {end do\}
991 end if
992 else
993 cmax(ixo^s,1)=max(wlp(ixo^s,mom(idim)),wrp(ixo^s,mom(idim)))+csoundl(ixo^s)
994 end if
995 if (hd_dust) then
996 wmean(ixo^s,1:nwflux)=0.5d0*(wlc(ixo^s,1:nwflux)+wrc(ixo^s,1:nwflux))
997 call dust_get_cmax(wmean, x, ixi^l, ixo^l, idim, cmax, cmin)
998 end if
999 end select
1000
1001 end subroutine hd_get_cbounds
1002
1003 !> Calculate the square of the thermal sound speed csound2 within ixO^L.
1004 !> csound2=gamma*p/rho
1005 subroutine hd_get_csound2(w,x,ixI^L,ixO^L,csound2)
1007 integer, intent(in) :: ixi^l, ixo^l
1008 double precision, intent(in) :: w(ixi^s,nw)
1009 double precision, intent(in) :: x(ixi^s,1:ndim)
1010 double precision, intent(out) :: csound2(ixi^s)
1011
1012 call hd_get_pthermal(w,x,ixi^l,ixo^l,csound2)
1013 csound2(ixo^s)=hd_gamma*csound2(ixo^s)/w(ixo^s,rho_)
1014
1015 end subroutine hd_get_csound2
1016
1017 !> Calculate thermal pressure=(gamma-1)*(e-0.5*m**2/rho) within ixO^L
1018 subroutine hd_get_pthermal(w, x, ixI^L, ixO^L, pth)
1022
1023 integer, intent(in) :: ixi^l, ixo^l
1024 double precision, intent(in) :: w(ixi^s, 1:nw)
1025 double precision, intent(in) :: x(ixi^s, 1:ndim)
1026 double precision, intent(out):: pth(ixi^s)
1027 integer :: iw, ix^d
1028
1029 if (hd_energy) then
1030 pth(ixo^s) = (hd_gamma - 1.0d0) * (w(ixo^s, e_) - &
1031 hd_kin_en(w, ixi^l, ixo^l))
1032 else
1033 if (.not. associated(usr_set_pthermal)) then
1034 pth(ixo^s) = hd_adiab * w(ixo^s, rho_)**hd_gamma
1035 else
1036 call usr_set_pthermal(w,x,ixi^l,ixo^l,pth)
1037 end if
1038 end if
1039
1040 if (fix_small_values) then
1041 {do ix^db= ixo^lim^db\}
1042 if(pth(ix^d)<small_pressure) then
1043 pth(ix^d)=small_pressure
1044 endif
1045 {enddo^d&\}
1046 else if (check_small_values) then
1047 {do ix^db= ixo^lim^db\}
1048 if(pth(ix^d)<small_pressure) then
1049 write(*,*) "Error: small value of gas pressure",pth(ix^d),&
1050 " encountered when call hd_get_pthermal"
1051 write(*,*) "Iteration: ", it, " Time: ", global_time
1052 write(*,*) "Location: ", x(ix^d,:)
1053 write(*,*) "Cell number: ", ix^d
1054 do iw=1,nw
1055 write(*,*) trim(cons_wnames(iw)),": ",w(ix^d,iw)
1056 end do
1057 ! use erroneous arithmetic operation to crash the run
1058 if(trace_small_values) write(*,*) dsqrt(pth(ix^d)-bigdouble)
1059 write(*,*) "Saving status at the previous time step"
1060 crash=.true.
1061 end if
1062 {enddo^d&\}
1063 end if
1064
1065 end subroutine hd_get_pthermal
1066
1067 !> Calculate temperature=p/rho when in e_ the total energy is stored
1068 subroutine hd_get_temperature_from_etot(w, x, ixI^L, ixO^L, res)
1070 integer, intent(in) :: ixi^l, ixo^l
1071 double precision, intent(in) :: w(ixi^s, 1:nw)
1072 double precision, intent(in) :: x(ixi^s, 1:ndim)
1073 double precision, intent(out):: res(ixi^s)
1074
1075 double precision :: r(ixi^s)
1076
1077 call hd_get_rfactor(w,x,ixi^l,ixo^l,r)
1078 call hd_get_pthermal(w, x, ixi^l, ixo^l, res)
1079 res(ixo^s)=res(ixo^s)/(r(ixo^s)*w(ixo^s,rho_))
1080 end subroutine hd_get_temperature_from_etot
1081
1082 !> Calculate temperature=p/rho when in e_ the internal energy is stored
1083 subroutine hd_get_temperature_from_eint(w, x, ixI^L, ixO^L, res)
1085 integer, intent(in) :: ixi^l, ixo^l
1086 double precision, intent(in) :: w(ixi^s, 1:nw)
1087 double precision, intent(in) :: x(ixi^s, 1:ndim)
1088 double precision, intent(out):: res(ixi^s)
1089
1090 double precision :: r(ixi^s)
1091
1092 call hd_get_rfactor(w,x,ixi^l,ixo^l,r)
1093 res(ixo^s) = (hd_gamma - 1.0d0) * w(ixo^s, e_)/(w(ixo^s,rho_)*r(ixo^s))
1094 end subroutine hd_get_temperature_from_eint
1095
1096 ! Calculate flux f_idim[iw]
1097 subroutine hd_get_flux(wC, w, x, ixI^L, ixO^L, idim, f)
1099 use mod_dust, only: dust_get_flux_prim
1100 use mod_viscosity, only: visc_get_flux_prim ! viscInDiv
1101
1102 integer, intent(in) :: ixi^l, ixo^l, idim
1103 ! conservative w
1104 double precision, intent(in) :: wc(ixi^s, 1:nw)
1105 ! primitive w
1106 double precision, intent(in) :: w(ixi^s, 1:nw)
1107 double precision, intent(in) :: x(ixi^s, 1:ndim)
1108 double precision, intent(out) :: f(ixi^s, nwflux)
1109
1110 double precision :: pth(ixi^s)
1111 integer :: ix^db
1112
1113 if (hd_energy) then
1114 {do ix^db=ixomin^db,ixomax^db\}
1115 f(ix^d,rho_)=w(ix^d,mom(idim))*w(ix^d,rho_)
1116 ! Momentum flux is v_i*m_i, +p in direction idim
1117 ^c&f(ix^d,m^c_)=w(ix^d,mom(idim))*wc(ix^d,m^c_)\
1118 f(ix^d,mom(idim))=f(ix^d,mom(idim))+w(ix^d,p_)
1119 ! Energy flux is v_i*(e + p)
1120 f(ix^d,e_)=w(ix^d,mom(idim))*(wc(ix^d,e_)+w(ix^d,p_))
1121 {end do\}
1122 else
1123 call hd_get_pthermal(wc, x, ixi^l, ixo^l, pth)
1124 {do ix^db=ixomin^db,ixomax^db\}
1125 f(ix^d,rho_)=w(ix^d,mom(idim))*w(ix^d,rho_)
1126 ! Momentum flux is v_i*m_i, +p in direction idim
1127 ^c&f(ix^d,m^c_)=w(ix^d,mom(idim))*wc(ix^d,m^c_)\
1128 f(ix^d,mom(idim))=f(ix^d,mom(idim))+pth(ix^d)
1129 {end do\}
1130 end if
1131
1132 do ix1 = 1, hd_n_tracer
1133 f(ixo^s, tracer(ix1)) = w(ixo^s,mom(idim)) * w(ixo^s, tracer(ix1))
1134 end do
1135
1136 ! Dust fluxes
1137 if (hd_dust) then
1138 call dust_get_flux_prim(w, x, ixi^l, ixo^l, idim, f)
1139 end if
1140
1141 ! Viscosity fluxes - viscInDiv
1142 if (hd_viscosity) then
1143 call visc_get_flux_prim(w, x, ixi^l, ixo^l, idim, f, hd_energy)
1144 endif
1145
1146 end subroutine hd_get_flux
1147
1148 !> Add geometrical source terms to w
1149 !>
1150 !> Notice that the expressions of the geometrical terms depend only on ndir,
1151 !> not ndim. Eg, they are the same in 2.5D and in 3D, for any geometry.
1152 !>
1153 !> Ileyk : to do :
1154 !> - address the source term for the dust in case (coordinate == spherical)
1155 subroutine hd_add_source_geom(qdt, dtfactor, ixI^L, ixO^L, wCT, wprim, w, x)
1158 use mod_viscosity, only: visc_add_source_geom ! viscInDiv
1161 use mod_geometry
1162 integer, intent(in) :: ixi^l, ixo^l
1163 double precision, intent(in) :: qdt, dtfactor, x(ixi^s, 1:ndim)
1164 double precision, intent(inout) :: wct(ixi^s, 1:nw), wprim(ixi^s,1:nw),w(ixi^s, 1:nw)
1165 ! to change and to set as a parameter in the parfile once the possibility to
1166 ! solve the equations in an angular momentum conserving form has been
1167 ! implemented (change tvdlf.t eg)
1168 double precision :: pth(ixi^s), source(ixi^s), minrho
1169 integer :: iw,idir, h1x^l{^nooned, h2x^l}
1170 integer :: mr_,mphi_ ! Polar var. names
1171 integer :: irho, ifluid, n_fluids
1172 double precision :: exp_factor(ixi^s), del_exp_factor(ixi^s), exp_factor_primitive(ixi^s)
1173
1174 if (hd_dust) then
1175 n_fluids = 1 + dust_n_species
1176 else
1177 n_fluids = 1
1178 end if
1179
1180 select case (coordinate)
1181
1183 !the user provides the functions of exp_factor and del_exp_factor
1184 if(associated(usr_set_surface)) call usr_set_surface(ixi^l,x,block%dx,exp_factor,del_exp_factor,exp_factor_primitive)
1185 if(hd_energy) then
1186 source(ixo^s)=wprim(ixo^s, p_)
1187 else
1188 if(.not. associated(usr_set_pthermal)) then
1189 source(ixo^s)=hd_adiab * wprim(ixo^s, rho_)**hd_gamma
1190 else
1191 call usr_set_pthermal(wct,x,ixi^l,ixo^l,source)
1192 end if
1193 end if
1194 source(ixo^s) = source(ixo^s)*del_exp_factor(ixo^s)/exp_factor(ixo^s)
1195 w(ixo^s,mom(1)) = w(ixo^s,mom(1)) + qdt*source(ixo^s)
1196
1197 case (cylindrical)
1198 do ifluid = 0, n_fluids-1
1199 ! s[mr]=(pthermal+mphi**2/rho)/radius
1200 if (ifluid == 0) then
1201 ! gas
1202 irho = rho_
1203 mr_ = mom(r_)
1204 if(phi_>0) mphi_ = mom(phi_)
1205 if(hd_energy) then
1206 source(ixo^s)=wprim(ixo^s, p_)
1207 else
1208 if(.not. associated(usr_set_pthermal)) then
1209 source(ixo^s)=hd_adiab * wprim(ixo^s, rho_)**hd_gamma
1210 else
1211 call usr_set_pthermal(wct,x,ixi^l,ixo^l,source)
1212 end if
1213 end if
1214 minrho = 0.0d0
1215 else
1216 ! dust : no pressure
1217 irho = dust_rho(ifluid)
1218 mr_ = dust_mom(r_, ifluid)
1219 if(phi_>0) mphi_ = dust_mom(phi_, ifluid)
1220 source(ixi^s) = zero
1221 minrho = 0.0d0
1222 end if
1223 if(phi_ > 0) then
1224 where (wct(ixo^s, irho) > minrho)
1225 source(ixo^s) = source(ixo^s) + wct(ixo^s,mphi_)*wprim(ixo^s,mphi_)
1226 w(ixo^s, mr_) = w(ixo^s, mr_) + qdt*source(ixo^s)/x(ixo^s,r_)
1227 end where
1228 ! s[mphi]=(-mphi*vr)/radius
1229 where (wct(ixo^s, irho) > minrho)
1230 source(ixo^s) = -wct(ixo^s, mphi_) * wprim(ixo^s, mr_)
1231 w(ixo^s, mphi_) = w(ixo^s, mphi_) + qdt * source(ixo^s) / x(ixo^s, r_)
1232 end where
1233 else
1234 ! s[mr]=2pthermal/radius
1235 w(ixo^s, mr_) = w(ixo^s, mr_) + qdt * source(ixo^s) / x(ixo^s, r_)
1236 end if
1237 end do
1238 case (spherical)
1239 if (hd_dust) then
1240 call mpistop("Dust geom source terms not implemented yet with spherical geometries")
1241 end if
1242 mr_ = mom(r_)
1243 if(phi_>0) mphi_ = mom(phi_)
1244 h1x^l=ixo^l-kr(1,^d); {^nooned h2x^l=ixo^l-kr(2,^d);}
1245 if(hd_energy) then
1246 pth(ixo^s)=wprim(ixo^s, p_)
1247 else
1248 if(.not. associated(usr_set_pthermal)) then
1249 pth(ixo^s)=hd_adiab * wprim(ixo^s, rho_)**hd_gamma
1250 else
1251 call usr_set_pthermal(wct,x,ixi^l,ixo^l,pth)
1252 end if
1253 end if
1254 ! s[mr]=((vtheta**2+vphi**2)*rho+2*p)/r
1255 source(ixo^s) = pth(ixo^s) * x(ixo^s, 1) &
1256 *(block%surfaceC(ixo^s, 1) - block%surfaceC(h1x^s, 1)) &
1257 /block%dvolume(ixo^s)
1258 do idir = 2, ndir
1259 source(ixo^s) = source(ixo^s) + wprim(ixo^s, mom(idir))**2 * wprim(ixo^s, rho_)
1260 end do
1261 w(ixo^s, mr_) = w(ixo^s, mr_) + qdt * source(ixo^s) / x(ixo^s, 1)
1262
1263 {^nooned
1264 ! s[mtheta]=-(vr*vtheta*rho)/r+cot(theta)*(vphi**2*rho+p)/r
1265 source(ixo^s) = pth(ixo^s) * x(ixo^s, 1) &
1266 * (block%surfaceC(ixo^s, 2) - block%surfaceC(h2x^s, 2)) &
1267 / block%dvolume(ixo^s)
1268 if (ndir == 3) then
1269 source(ixo^s) = source(ixo^s) + (wprim(ixo^s, mom(3))**2 * wprim(ixo^s, rho_)) / tan(x(ixo^s, 2))
1270 end if
1271 source(ixo^s) = source(ixo^s) - (wprim(ixo^s, mom(2)) * wprim(ixo^s, mr_)) * wprim(ixo^s, rho_)
1272 w(ixo^s, mom(2)) = w(ixo^s, mom(2)) + qdt * source(ixo^s) / x(ixo^s, 1)
1273
1274 if (ndir == 3) then
1275 ! s[mphi]=-(vphi*vr/rho)/r-cot(theta)*(vtheta*vphi/rho)/r
1276 source(ixo^s) = -(wprim(ixo^s, mom(3)) * wprim(ixo^s, mr_)) * wprim(ixo^s, rho_)&
1277 - (wprim(ixo^s, mom(2)) * wprim(ixo^s, mom(3))) * wprim(ixo^s, rho_) / tan(x(ixo^s, 2))
1278 w(ixo^s, mom(3)) = w(ixo^s, mom(3)) + qdt * source(ixo^s) / x(ixo^s, 1)
1279 end if
1280 }
1281 end select
1282
1283 if (hd_viscosity) call visc_add_source_geom(qdt,ixi^l,ixo^l,wprim,w,x)
1284
1285 if (hd_rotating_frame) then
1286 if (hd_dust) then
1287 call mpistop("Rotating frame not implemented yet with dust")
1288 else
1289 call rotating_frame_add_source(qdt,dtfactor,ixi^l,ixo^l,wprim,w,x)
1290 end if
1291 end if
1292
1293 end subroutine hd_add_source_geom
1294
1295 ! w[iw]= w[iw]+qdt*S[wCT, qtC, x] where S is the source based on wCT within ixO
1296 subroutine hd_add_source(qdt,dtfactor, ixI^L,ixO^L,wCT,wCTprim,w,x,qsourcesplit,active)
1301 use mod_usr_methods, only: usr_gravity
1303 use mod_cak_force, only: cak_add_source
1304
1305 integer, intent(in) :: ixi^l, ixo^l
1306 double precision, intent(in) :: qdt, dtfactor
1307 double precision, intent(in) :: wct(ixi^s, 1:nw),wctprim(ixi^s,1:nw), x(ixi^s, 1:ndim)
1308 double precision, intent(inout) :: w(ixi^s, 1:nw)
1309 logical, intent(in) :: qsourcesplit
1310 logical, intent(inout) :: active
1311
1312 double precision :: gravity_field(ixi^s, 1:ndim)
1313 integer :: idust, idim
1314
1315 if(hd_dust .and. .not. use_imex_scheme) then
1316 call dust_add_source(qdt,ixi^l,ixo^l,wct,w,x,qsourcesplit,active)
1317 end if
1318
1319 if(hd_radiative_cooling) then
1320 call radiative_cooling_add_source(qdt,ixi^l,ixo^l,wct,wctprim,w,x,&
1321 qsourcesplit,active, rc_fl)
1322 end if
1323
1324 if(hd_viscosity) then
1325 call viscosity_add_source(qdt,ixi^l,ixo^l,wct,w,x,&
1326 hd_energy,qsourcesplit,active)
1327 end if
1328
1329 if (hd_gravity) then
1330 call gravity_add_source(qdt,ixi^l,ixo^l,wct,wctprim,w,x,&
1331 hd_energy,.false.,qsourcesplit,active)
1332
1333 if (hd_dust .and. qsourcesplit .eqv. grav_split) then
1334 active = .true.
1335
1336 call usr_gravity(ixi^l, ixo^l, wct, x, gravity_field)
1337 do idust = 1, dust_n_species
1338 do idim = 1, ndim
1339 w(ixo^s, dust_mom(idim, idust)) = w(ixo^s, dust_mom(idim, idust)) &
1340 + qdt * gravity_field(ixo^s, idim) * wct(ixo^s, dust_rho(idust))
1341 end do
1342 end do
1343 end if
1344 end if
1345
1346 if (hd_cak_force) then
1347 call cak_add_source(qdt,ixi^l,ixo^l,wct,w,x,hd_energy,qsourcesplit,active)
1348 end if
1349
1350 if(hd_partial_ionization) then
1351 if(.not.qsourcesplit) then
1352 active = .true.
1353 call hd_update_temperature(ixi^l,ixo^l,wct,w,x)
1354 end if
1355 end if
1356
1357 end subroutine hd_add_source
1358
1359 subroutine hd_get_dt(w, ixI^L, ixO^L, dtnew, dx^D, x)
1361 use mod_dust, only: dust_get_dt
1364 use mod_gravity, only: gravity_get_dt
1365 use mod_cak_force, only: cak_get_dt
1366
1367 integer, intent(in) :: ixi^l, ixo^l
1368 double precision, intent(in) :: dx^d, x(ixi^s, 1:^nd)
1369 double precision, intent(in) :: w(ixi^s, 1:nw)
1370 double precision, intent(inout) :: dtnew
1371
1372 dtnew = bigdouble
1373
1374 if(hd_dust) then
1375 call dust_get_dt(w, ixi^l, ixo^l, dtnew, dx^d, x)
1376 end if
1377
1378 if(hd_radiative_cooling) then
1379 call cooling_get_dt(w,ixi^l,ixo^l,dtnew,dx^d,x,rc_fl)
1380 end if
1381
1382 if(hd_viscosity) then
1383 call viscosity_get_dt(w,ixi^l,ixo^l,dtnew,dx^d,x)
1384 end if
1385
1386 if(hd_gravity) then
1387 call gravity_get_dt(w,ixi^l,ixo^l,dtnew,dx^d,x)
1388 end if
1389
1390 if (hd_cak_force) then
1391 call cak_get_dt(w,ixi^l,ixo^l,dtnew,dx^d,x)
1392 end if
1393
1394 end subroutine hd_get_dt
1395
1396 function hd_kin_en(w, ixI^L, ixO^L, inv_rho) result(ke)
1397 use mod_global_parameters, only: nw, ndim
1398 integer, intent(in) :: ixi^l, ixo^l
1399 double precision, intent(in) :: w(ixi^s, nw)
1400 double precision :: ke(ixo^s)
1401 double precision, intent(in), optional :: inv_rho(ixo^s)
1402
1403 if (present(inv_rho)) then
1404 ke = 0.5d0 * sum(w(ixo^s, mom(:))**2, dim=ndim+1) * inv_rho
1405 else
1406 ke = 0.5d0 * sum(w(ixo^s, mom(:))**2, dim=ndim+1) / w(ixo^s, rho_)
1407 end if
1408 end function hd_kin_en
1409
1410 function hd_inv_rho(w, ixI^L, ixO^L) result(inv_rho)
1411 use mod_global_parameters, only: nw, ndim
1412 integer, intent(in) :: ixi^l, ixo^l
1413 double precision, intent(in) :: w(ixi^s, nw)
1414 double precision :: inv_rho(ixo^s)
1415
1416 ! Can make this more robust
1417 inv_rho = 1.0d0 / w(ixo^s, rho_)
1418 end function hd_inv_rho
1419
1420 subroutine hd_handle_small_values(primitive, w, x, ixI^L, ixO^L, subname)
1421 ! handles hydro (density,pressure,velocity) bootstrapping
1422 ! any negative dust density is flagged as well (and throws an error)
1423 ! small_values_method=replace also for dust
1427 logical, intent(in) :: primitive
1428 integer, intent(in) :: ixi^l,ixo^l
1429 double precision, intent(inout) :: w(ixi^s,1:nw)
1430 double precision, intent(in) :: x(ixi^s,1:ndim)
1431 character(len=*), intent(in) :: subname
1432
1433 integer :: n,idir
1434 logical :: flag(ixi^s,1:nw)
1435
1436 call hd_check_w(primitive, ixi^l, ixo^l, w, flag)
1437
1438 if (any(flag)) then
1439 select case (small_values_method)
1440 case ("replace")
1441 where(flag(ixo^s,rho_)) w(ixo^s,rho_) = small_density
1442 do idir = 1, ndir
1443 if(small_values_fix_iw(mom(idir))) then
1444 where(flag(ixo^s,rho_)) w(ixo^s, mom(idir)) = 0.0d0
1445 end if
1446 end do
1447 if(hd_energy)then
1448 if(small_values_fix_iw(e_)) then
1449 if(primitive) then
1450 where(flag(ixo^s,rho_)) w(ixo^s, p_) = small_pressure
1451 else
1452 where(flag(ixo^s,rho_)) w(ixo^s, e_) = small_e + hd_kin_en(w,ixi^l,ixo^l)
1453 endif
1454 end if
1455 endif
1456
1457 if(hd_energy) then
1458 if(primitive) then
1459 where(flag(ixo^s,e_)) w(ixo^s,p_) = small_pressure
1460 else
1461 where(flag(ixo^s,e_))
1462 ! Add kinetic energy
1463 w(ixo^s,e_) = small_e + hd_kin_en(w,ixi^l,ixo^l)
1464 end where
1465 end if
1466 end if
1467
1468 if(hd_dust)then
1469 do n=1,dust_n_species
1470 where(flag(ixo^s,dust_rho(n))) w(ixo^s,dust_rho(n)) = 0.0d0
1471 do idir = 1, ndir
1472 where(flag(ixo^s,dust_rho(n))) w(ixo^s,dust_mom(idir,n)) = 0.0d0
1473 enddo
1474 enddo
1475 endif
1476 case ("average")
1477 if(primitive)then
1478 ! averaging for all primitive fields, including dust
1479 call small_values_average(ixi^l, ixo^l, w, x, flag)
1480 else
1481 ! do averaging of density
1482 call small_values_average(ixi^l, ixo^l, w, x, flag, rho_)
1483 if(hd_energy) then
1484 ! do averaging of pressure
1485 w(ixi^s,p_)=(hd_gamma-1.d0)*(w(ixi^s,e_) &
1486 -0.5d0*sum(w(ixi^s, mom(:))**2, dim=ndim+1)/w(ixi^s,rho_))
1487 call small_values_average(ixi^l, ixo^l, w, x, flag, p_)
1488 w(ixi^s,e_)=w(ixi^s,p_)/(hd_gamma-1.d0) &
1489 +0.5d0*sum(w(ixi^s, mom(:))**2, dim=ndim+1)/w(ixi^s,rho_)
1490 end if
1491 if(hd_dust)then
1492 do n=1,dust_n_species
1493 where(flag(ixo^s,dust_rho(n))) w(ixo^s,dust_rho(n)) = 0.0d0
1494 do idir = 1, ndir
1495 where(flag(ixo^s,dust_rho(n))) w(ixo^s,dust_mom(idir,n)) = 0.0d0
1496 enddo
1497 enddo
1498 endif
1499 endif
1500 case default
1501 if(.not.primitive) then
1502 !convert w to primitive
1503 ! Calculate pressure = (gamma-1) * (e-ek)
1504 if(hd_energy) then
1505 w(ixo^s,p_)=(hd_gamma-1.d0)*(w(ixo^s,e_)-hd_kin_en(w,ixi^l,ixo^l))
1506 end if
1507 ! Convert gas momentum to velocity
1508 do idir = 1, ndir
1509 w(ixo^s, mom(idir)) = w(ixo^s, mom(idir))/w(ixo^s,rho_)
1510 end do
1511 end if
1512 ! NOTE: dust entries may still have conserved values here
1513 call small_values_error(w, x, ixi^l, ixo^l, flag, subname)
1514 end select
1515 end if
1516 end subroutine hd_handle_small_values
1517
1518 subroutine rfactor_from_temperature_ionization(w,x,ixI^L,ixO^L,Rfactor)
1521 integer, intent(in) :: ixi^l, ixo^l
1522 double precision, intent(in) :: w(ixi^s,1:nw)
1523 double precision, intent(in) :: x(ixi^s,1:ndim)
1524 double precision, intent(out):: rfactor(ixi^s)
1525
1526 double precision :: iz_h(ixo^s),iz_he(ixo^s)
1527
1528 call ionization_degree_from_temperature(ixi^l,ixo^l,w(ixi^s,te_),iz_h,iz_he)
1529 ! assume the first and second ionization of Helium have the same degree
1530 rfactor(ixo^s)=(1.d0+iz_h(ixo^s)+0.1d0*(1.d0+iz_he(ixo^s)*(1.d0+iz_he(ixo^s))))/2.3d0
1531
1532 end subroutine rfactor_from_temperature_ionization
1533
1534 subroutine rfactor_from_constant_ionization(w,x,ixI^L,ixO^L,Rfactor)
1536 integer, intent(in) :: ixi^l, ixo^l
1537 double precision, intent(in) :: w(ixi^s,1:nw)
1538 double precision, intent(in) :: x(ixi^s,1:ndim)
1539 double precision, intent(out):: rfactor(ixi^s)
1540
1541 rfactor(ixo^s)=rr
1542
1543 end subroutine rfactor_from_constant_ionization
1544
1545 subroutine hd_update_temperature(ixI^L,ixO^L,wCT,w,x)
1548
1549 integer, intent(in) :: ixi^l, ixo^l
1550 double precision, intent(in) :: wct(ixi^s,1:nw), x(ixi^s,1:ndim)
1551 double precision, intent(inout) :: w(ixi^s,1:nw)
1552
1553 double precision :: iz_h(ixo^s),iz_he(ixo^s), pth(ixi^s)
1554
1555 call ionization_degree_from_temperature(ixi^l,ixo^l,wct(ixi^s,te_),iz_h,iz_he)
1556
1557 call hd_get_pthermal(w,x,ixi^l,ixo^l,pth)
1558
1559 w(ixo^s,te_)=(2.d0+3.d0*he_abundance)*pth(ixo^s)/(w(ixo^s,rho_)*(1.d0+iz_h(ixo^s)+&
1560 he_abundance*(iz_he(ixo^s)*(iz_he(ixo^s)+1.d0)+1.d0)))
1561
1562 end subroutine hd_update_temperature
1563
1564end module mod_hd_phys
Calculate w(iw)=w(iw)+qdt*SOURCE[wCT,qtC,x] within ixO for all indices iw=iwmin......
Module with basic data types used in amrvac.
integer, parameter std_len
Default length for strings.
Module to include CAK radiation line force in (magneto)hydrodynamic models Computes both the force fr...
subroutine cak_get_dt(w, ixil, ixol, dtnew, dxd, x)
Check time step for total radiation contribution.
subroutine cak_init(phys_gamma)
Initialize the module.
subroutine cak_add_source(qdt, ixil, ixol, wct, w, x, energy, qsourcesplit, active)
w[iw]=w[iw]+qdt*S[wCT,qtC,x] where S is the source based on wCT within ixO
subroutine, public mpistop(message)
Exit MPI-AMRVAC with an error message.
Module for physical and numeric constants.
double precision, parameter bigdouble
A very large real number.
Module for including dust species, which interact with the gas through a drag force.
Definition mod_dust.t:3
subroutine, public dust_add_source(qdt, ixil, ixol, wct, w, x, qsourcesplit, active)
w[iw]= w[iw]+qdt*S[wCT, x] where S is the source based on wCT within ixO
Definition mod_dust.t:530
subroutine, public dust_evaluate_implicit(qtc, psa)
inplace update of psa==>F_im(psa)
Definition mod_dust.t:583
subroutine, public dust_to_primitive(ixil, ixol, w, x)
Definition mod_dust.t:228
subroutine, public dust_get_dt(w, ixil, ixol, dtnew, dxd, x)
Get dt related to dust and gas stopping time (Laibe 2011)
Definition mod_dust.t:898
integer, dimension(:, :), allocatable, public, protected dust_mom
Indices of the dust momentum densities.
Definition mod_dust.t:47
subroutine, public dust_to_conserved(ixil, ixol, w, x)
Definition mod_dust.t:208
integer, public, protected dust_n_species
The number of dust species.
Definition mod_dust.t:37
subroutine, public dust_get_flux_prim(w, x, ixil, ixol, idim, f)
Definition mod_dust.t:275
subroutine, public dust_check_w(ixil, ixol, w, flag)
Definition mod_dust.t:194
integer, dimension(:), allocatable, public, protected dust_rho
Indices of the dust densities.
Definition mod_dust.t:44
subroutine, public dust_get_cmax(w, x, ixil, ixol, idim, cmax, cmin)
Definition mod_dust.t:1011
subroutine, public dust_check_params()
Definition mod_dust.t:154
subroutine, public dust_get_cmax_prim(w, x, ixil, ixol, idim, cmax, cmin)
Definition mod_dust.t:1035
subroutine, public dust_init(g_rho, g_mom, g_energy)
Definition mod_dust.t:95
subroutine, public dust_implicit_update(dtfactor, qdt, qtc, psb, psa)
Implicit solve of psb=psa+dtfactor*dt*F_im(psb)
Definition mod_dust.t:652
Module for flux conservation near refinement boundaries.
Module with geometry-related routines (e.g., divergence, curl)
Definition mod_geometry.t:2
integer coordinate
Definition mod_geometry.t:7
integer, parameter spherical
integer, parameter cylindrical
integer, parameter cartesian_expansion
This module contains definitions of global parameters and variables and some generic functions/subrou...
type(state), pointer block
Block pointer for using one block and its previous state.
logical h_correction
If true, do H-correction to fix the carbuncle problem at grid-aligned shocks.
double precision unit_time
Physical scaling factor for time.
double precision unit_density
Physical scaling factor for density.
integer, parameter unitpar
file handle for IO
double precision global_time
The global simulation time.
double precision unit_mass
Physical scaling factor for mass.
logical use_imex_scheme
whether IMEX in use or not
integer, dimension(3, 3) kr
Kronecker delta tensor.
integer it
Number of time steps taken.
double precision unit_numberdensity
Physical scaling factor for number density.
character(len=std_len) convert_type
Which format to use when converting.
double precision unit_pressure
Physical scaling factor for pressure.
integer, parameter ndim
Number of spatial dimensions for grid variables.
double precision unit_length
Physical scaling factor for length.
logical use_particles
Use particles module or not.
character(len=std_len), dimension(:), allocatable par_files
Which par files are used as input.
integer mype
The rank of the current MPI task.
double precision, dimension(:), allocatable, parameter d
integer ndir
Number of spatial dimensions (components) for vector variables.
double precision unit_velocity
Physical scaling factor for velocity.
double precision unit_temperature
Physical scaling factor for temperature.
logical si_unit
Use SI units (.true.) or use cgs units (.false.)
double precision, dimension(:,:), allocatable dx
logical phys_trac
Use TRAC for MHD or 1D HD.
logical fix_small_values
fix small values with average or replace methods
logical crash
Save a snapshot before crash a run met unphysical values.
double precision, dimension(^nd) dxlevel
store unstretched cell size of current level
integer r_
Indices for cylindrical coordinates FOR TESTS, negative value when not used:
integer boundspeed
bound (left/min and right.max) speed of Riemann fan
integer, parameter unitconvert
logical check_small_values
check and optionally fix unphysical small values (density, gas pressure)
Module for including gravity in (magneto)hydrodynamics simulations.
Definition mod_gravity.t:2
logical grav_split
source split or not
Definition mod_gravity.t:6
subroutine gravity_get_dt(w, ixil, ixol, dtnew, dxd, x)
Definition mod_gravity.t:87
subroutine gravity_init()
Initialize the module.
Definition mod_gravity.t:26
subroutine gravity_add_source(qdt, ixil, ixol, wct, wctprim, w, x, energy, rhov, qsourcesplit, active)
w[iw]=w[iw]+qdt*S[wCT,qtC,x] where S is the source based on wCT within ixO
Definition mod_gravity.t:43
Hydrodynamics physics module.
Definition mod_hd_phys.t:2
integer, public, protected m
Definition mod_hd_phys.t:54
subroutine, public hd_check_params
logical, public, protected hd_energy
Whether an energy equation is used.
Definition mod_hd_phys.t:12
logical, public, protected hd_dust
Whether dust is added.
Definition mod_hd_phys.t:24
integer, public, protected e_
Index of the energy density (-1 if not present)
Definition mod_hd_phys.t:60
logical, public, protected hd_radiative_cooling
Whether radiative cooling is added.
Definition mod_hd_phys.t:20
double precision, public, protected rr
double precision, public hd_gamma
The adiabatic index.
Definition mod_hd_phys.t:72
integer, public, protected hd_trac_type
Definition mod_hd_phys.t:85
logical, public, protected hd_particles
Whether particles module is added.
Definition mod_hd_phys.t:33
type(tc_fluid), allocatable, public tc_fl
Definition mod_hd_phys.t:16
subroutine, public hd_check_w(primitive, ixil, ixol, w, flag)
Returns logical argument flag where values are ok.
logical, public, protected hd_viscosity
Whether viscosity is added.
Definition mod_hd_phys.t:27
integer, public, protected c
Indices of the momentum density for the form of better vectorization.
Definition mod_hd_phys.t:54
subroutine, public hd_get_csound2(w, x, ixil, ixol, csound2)
Calculate the square of the thermal sound speed csound2 within ixO^L. csound2=gamma*p/rho.
integer, public, protected tcoff_
Index of the cutoff temperature for the TRAC method.
Definition mod_hd_phys.t:69
double precision, public, protected he_ion_fr2
Ratio of number He2+ / number He+ + He2+ He_ion_fr2 = He2+/(He2+ + He+)
Definition mod_hd_phys.t:97
integer, public, protected te_
Indices of temperature.
Definition mod_hd_phys.t:66
integer, dimension(:), allocatable, public, protected mom
Indices of the momentum density.
Definition mod_hd_phys.t:51
double precision, public, protected h_ion_fr
Ionization fraction of H H_ion_fr = H+/(H+ + H)
Definition mod_hd_phys.t:91
double precision function, dimension(ixo^s), public hd_kin_en(w, ixil, ixol, inv_rho)
subroutine, public hd_to_conserved(ixil, ixol, w, x)
Transform primitive variables into conservative ones.
logical, public, protected hd_cak_force
Whether CAK radiation line force is activated.
Definition mod_hd_phys.t:39
subroutine, public hd_phys_init()
Initialize the module.
integer, dimension(:), allocatable, public, protected tracer
Indices of the tracers.
Definition mod_hd_phys.t:57
logical, public, protected hd_thermal_conduction
Whether thermal conduction is added.
Definition mod_hd_phys.t:15
logical, public, protected eq_state_units
double precision, public hd_adiab
The adiabatic constant.
Definition mod_hd_phys.t:78
subroutine, public hd_to_primitive(ixil, ixol, w, x)
Transform conservative variables into primitive ones.
integer, public, protected rho_
Index of the density (in the w array)
Definition mod_hd_phys.t:48
logical, public, protected hd_partial_ionization
Whether plasma is partially ionized.
Definition mod_hd_phys.t:45
double precision, public, protected he_ion_fr
Ionization fraction of He He_ion_fr = (He2+ + He+)/(He2+ + He+ + He)
Definition mod_hd_phys.t:94
double precision, public, protected he_abundance
Helium abundance over Hydrogen.
Definition mod_hd_phys.t:88
logical, public, protected hd_gravity
Whether gravity is added.
Definition mod_hd_phys.t:30
integer, public, protected c_
Definition mod_hd_phys.t:54
type(rc_fluid), allocatable, public rc_fl
Definition mod_hd_phys.t:21
logical, public, protected hd_trac
Whether TRAC method is used.
Definition mod_hd_phys.t:84
integer, public, protected hd_n_tracer
Number of tracer species.
Definition mod_hd_phys.t:42
type(te_fluid), allocatable, public te_fl_hd
Definition mod_hd_phys.t:17
logical, public, protected hd_rotating_frame
Whether rotating frame is activated.
Definition mod_hd_phys.t:36
subroutine, public hd_get_pthermal(w, x, ixil, ixol, pth)
Calculate thermal pressure=(gamma-1)*(e-0.5*m**2/rho) within ixO^L.
integer, public, protected p_
Index of the gas pressure (-1 if not present) should equal e_.
Definition mod_hd_phys.t:63
module ionization degree - get ionization degree for given temperature
subroutine ionization_degree_from_temperature(ixil, ixol, te, iz_h, iz_he)
Module containing all the particle routines.
subroutine particles_init()
Initialize particle data and parameters.
This module defines the procedures of a physics module. It contains function pointers for the various...
Definition mod_physics.t:4
module radiative cooling – add optically thin radiative cooling for HD and MHD
subroutine radiative_cooling_init_params(phys_gamma, he_abund)
Radiative cooling initialization.
subroutine cooling_get_dt(w, ixil, ixol, dtnew, dxd, x, fl)
subroutine radiative_cooling_init(fl, read_params)
subroutine radiative_cooling_add_source(qdt, ixil, ixol, wct, wctprim, w, x, qsourcesplit, active, fl)
Module for including rotating frame in (magneto)hydrodynamics simulations The rotation vector is assu...
subroutine rotating_frame_add_source(qdt, dtfactor, ixil, ixol, wct, w, x)
w[iw]=w[iw]+qdt*S[wCT,qtC,x] where S is the source based on wCT within ixO
subroutine rotating_frame_init()
Initialize the module.
Module for handling problematic values in simulations, such as negative pressures.
subroutine, public small_values_average(ixil, ixol, w, x, w_flag, windex)
logical, public trace_small_values
trace small values in the source file using traceback flag of compiler
subroutine, public small_values_error(wprim, x, ixil, ixol, w_flag, subname)
logical, dimension(:), allocatable, public small_values_fix_iw
Whether to apply small value fixes to certain variables.
character(len=20), public small_values_method
How to handle small values.
Generic supertimestepping method 1) in amrvac.par in sts_list set the following parameters which have...
subroutine, public add_sts_method(sts_getdt, sts_set_sources, startvar, nflux, startwbc, nwbc, evolve_b)
subroutine which added programatically a term to be calculated using STS Params: sts_getdt function c...
subroutine, public set_conversion_methods_to_head(sts_before_first_cycle, sts_after_last_cycle)
Set the hooks called before the first cycle and after the last cycle in the STS update This method sh...
subroutine, public set_error_handling_to_head(sts_error_handling)
Set the hook of error handling in the STS update. This method is called before updating the BC....
subroutine, public sts_init()
Initialize sts module.
Thermal conduction for HD and MHD or RHD and RMHD or twofl (plasma-neutral) module Adaptation of mod_...
subroutine, public tc_get_hd_params(fl, read_hd_params)
Init TC coefficients: HD case.
double precision function, public get_tc_dt_hd(w, ixil, ixol, dxd, x, fl)
Get the explicit timestep for the TC (hd implementation)
subroutine tc_init_params(phys_gamma)
subroutine, public sts_set_source_tc_hd(ixil, ixol, w, x, wres, fix_conserve_at_step, my_dt, igrid, nflux, fl)
subroutine get_euv_image(qunit, fl)
subroutine get_sxr_image(qunit, fl)
subroutine get_euv_spectrum(qunit, fl)
subroutine get_whitelight_image(qunit, fl)
Module with all the methods that users can customize in AMRVAC.
procedure(rfactor), pointer usr_rfactor
procedure(set_surface), pointer usr_set_surface
procedure(phys_gravity), pointer usr_gravity
procedure(hd_pthermal), pointer usr_set_pthermal
integer nw
Total number of variables.
integer number_species
number of species: each species has different characterictic speeds and should be used accordingly in...
The module add viscous source terms and check time step.
subroutine, public visc_get_flux_prim(w, x, ixil, ixol, idim, f, energy)
subroutine viscosity_add_source(qdt, ixil, ixol, wct, w, x, energy, qsourcesplit, active)
subroutine viscosity_init(phys_wider_stencil)
Initialize the module.
subroutine viscosity_get_dt(w, ixil, ixol, dtnew, dxd, x)
subroutine visc_add_source_geom(qdt, ixil, ixol, wct, w, x)