24 logical,
public,
protected ::
hd_dust = .false.
48 integer,
public,
protected ::
rho_
51 integer,
allocatable,
public,
protected ::
mom(:)
54 integer,
public,
protected :: ^
c&m^C_
57 integer,
allocatable,
public,
protected ::
tracer(:)
60 integer,
public,
protected ::
e_
63 integer,
public,
protected ::
p_
66 integer,
public,
protected ::
te_
72 double precision,
public ::
hd_gamma = 5.d0/3.0d0
75 double precision :: gamma_1, inv_gamma_1
81 double precision,
protected :: small_e
84 logical,
public,
protected ::
hd_trac = .false.
91 double precision,
public,
protected ::
h_ion_fr=1d0
94 double precision,
public,
protected ::
he_ion_fr=1d0
101 double precision,
public,
protected ::
rr=1d0
121 subroutine hd_read_params(files)
123 character(len=*),
intent(in) :: files(:)
132 do n = 1,
size(files)
133 open(
unitpar, file=trim(files(n)), status=
"old")
134 read(
unitpar, hd_list,
end=111)
138 end subroutine hd_read_params
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
150 call mpi_file_write(fh, n_par, 1, mpi_integer, st, er)
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
181 phys_internal_e = .false.
190 if(
mype==0)
write(*,*)
'WARNING: set hd_trac_type=1'
195 if(
mype==0)
write(*,*)
'WARNING: set hd_trac=F when ndim>=2'
203 if(
mype==0)
write(*,*)
'WARNING: set hd_thermal_conduction=F when hd_energy=F'
207 if(
mype==0)
write(*,*)
'WARNING: set hd_radiative_cooling=F when hd_energy=F'
213 if(
mype==0)
write(*,*)
'WARNING: set hd_partial_ionization=F when eq_state_units=F'
218 allocate(start_indices(number_species),stop_indices(number_species))
226 mom(:) = var_set_momentum(
ndir)
231 e_ = var_set_energy()
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
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
257 call hd_physical_units()
267 tracer(itr) = var_set_fluxvar(
"trc",
"trp", itr, need_bc=.false.)
274 stop_indices(1)=nwflux
278 te_ = var_set_auxvar(
'Te',
'Te')
292 hd_get_rfactor=>rfactor_from_temperature_ionization
293 phys_update_temperature => hd_update_temperature
297 hd_get_rfactor=>rfactor_from_constant_ionization
303 call mpistop(
"thermal conduction needs hd_energy=T")
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
322 call mpistop(
"radiative cooling needs hd_energy=T")
326 rc_fl%get_rho => hd_get_rho
328 rc_fl%get_var_Rfactor => hd_get_rfactor
335 te_fl_hd%get_var_Rfactor => hd_get_rfactor
337 phys_te_images => hd_te_images
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")
365 allocate(iw_vector(nvector))
366 iw_vector(1) =
mom(1) - 1
373 subroutine hd_te_images
377 case(
'EIvtiCCmpi',
'EIvtuCCmpi')
379 case(
'ESvtiCCmpi',
'ESvtuCCmpi')
381 case(
'SIvtiCCmpi',
'SIvtuCCmpi')
383 case(
'WIvtiCCmpi',
'WIvtuCCmpi')
386 call mpistop(
"Error in synthesize emission: Unknown convert_type")
388 end subroutine hd_te_images
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
403 end subroutine hd_sts_set_source_tc_hd
405 function hd_get_tc_dt_hd(w,ixI^L,ixO^L,dx^D,x)
result(dtnew)
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
418 end function hd_get_tc_dt_hd
420 subroutine hd_tc_handle_small_e(w, x, ixI^L, ixO^L, step)
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
431 logical :: flag(ixi^s,1:nw)
432 character(len=140) :: error_msg
435 where(w(ixo^s,
e_)<small_e) flag(ixo^s,
e_)=.true.
436 if(any(flag(ixo^s,
e_)))
then
439 where(flag(ixo^s,
e_)) w(ixo^s,
e_)=small_e
446 w(ixo^s, iw_mom(idir)) = w(ixo^s, iw_mom(idir))/w(ixo^s,
rho_)
448 write(error_msg,
"(a,i3)")
"Thermal conduction step ", step
452 end subroutine hd_tc_handle_small_e
455 subroutine tc_params_read_hd(fl)
457 type(tc_fluid),
intent(inout) :: fl
459 logical :: tc_saturate=.false.
460 double precision :: tc_k_para=0d0
462 namelist /tc_list/ tc_saturate, tc_k_para
466 read(
unitpar, tc_list,
end=111)
469 fl%tc_saturate = tc_saturate
470 fl%tc_k_para = tc_k_para
472 end subroutine tc_params_read_hd
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)
480 rho(ixo^s) = w(ixo^s,
rho_)
482 end subroutine hd_get_rho
486 subroutine rc_params_read(fl)
490 type(rc_fluid),
intent(inout) :: fl
493 integer :: ncool = 4000
494 double precision :: cfrac=0.1d0
497 character(len=std_len) :: coolcurve=
'JCcorona'
500 character(len=std_len) :: coolmethod=
'exact'
503 logical :: tfix=.false.
509 logical :: rc_split=.false.
512 namelist /rc_list/ coolcurve, coolmethod, ncool, cfrac, tlow, tfix, rc_split
516 read(
unitpar, rc_list,
end=111)
521 fl%coolcurve=coolcurve
522 fl%coolmethod=coolmethod
527 end subroutine rc_params_read
535 if (
hd_gamma <= 0.0d0)
call mpistop (
"Error: hd_gamma <= 0")
536 if (
hd_adiab < 0.0d0)
call mpistop (
"Error: hd_adiab < 0")
540 call mpistop (
"Error: hd_gamma <= 0 or hd_gamma == 1.0")
554 subroutine hd_physical_units
556 double precision :: mp,kb
557 double precision :: a,b
645 end subroutine hd_physical_units
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)
665 half*(^
c&w(ixo^s,
m^
c_)**2+)/w(ixo^s,
rho_))
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)
686 {
do ix^db=ixomin^db,ixomax^db\}
689 w(ix^
d,
e_)=w(ix^
d,
e_)*inv_gamma_1+&
697 call dust_to_conserved(ixi^l, ixo^l, w, x)
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)
710 double precision :: inv_rho
714 call hd_handle_small_values(.false., w, x, ixi^
l, ixo^
l,
'hd_to_primitive')
717 {
do ix^db=ixomin^db,ixomax^db\}
718 inv_rho = 1.d0/w(ix^
d,
rho_)
731 call dust_to_primitive(ixi^l, ixo^l, w, x)
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)
744 w(ixo^s,
e_)=w(ixo^s,
e_)+half*(^
c&w(ixo^s,
m^
c_)**2+)/w(ixo^s,
rho_)
746 end subroutine hd_ei_to_e
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)
756 w(ixo^s,
e_)=w(ixo^s,
e_)-half*(^
c&w(ixo^s,
m^
c_)**2+)/w(ixo^s,
rho_)
758 end subroutine hd_e_to_ei
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)
767 v(ixo^s) = w(ixo^s,
mom(idim)) / w(ixo^s,
rho_)
768 end subroutine hd_get_v_idim
771 subroutine hd_get_v(w,x,ixI^L,ixO^L,v)
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)
781 v(ixo^s,idir) = w(ixo^s,
mom(idir)) / w(ixo^s,
rho_)
784 end subroutine hd_get_v
787 subroutine hd_get_cmax(w, x, ixI^L, ixO^L, idim, cmax)
792 integer,
intent(in) :: ixi^
l, ixo^
l, idim
794 double precision,
intent(in) :: w(ixi^s, nw), x(ixi^s, 1:
ndim)
795 double precision,
intent(inout) :: cmax(ixi^s)
805 cmax(ixo^s)=dabs(w(ixo^s,
mom(idim)))+dsqrt(
hd_gamma*cmax(ixo^s)/w(ixo^s,
rho_))
811 end subroutine hd_get_cmax
813 subroutine hd_get_a2max(w,x,ixI^L,ixO^L,a2max)
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
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
833 end subroutine hd_get_a2max
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)
841 double precision,
intent(inout) :: w(ixi^s,1:nw)
842 double precision,
intent(out) :: tco_local, tmax_local
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)
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_))
856 tmax_local=maxval(te(ixo^s))
863 lts(ixo^s)=0.5d0*dabs(te(jxo^s)-te(hxo^s))/te(ixo^s)
865 where(lts(ixo^s) > trac_delta)
868 if(any(lrlt(ixo^s)))
then
869 tco_local=maxval(te(ixo^s), mask=lrlt(ixo^s))
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
885 call mpistop(
"mhd_trac_type not allowed for 1D simulation")
888 end subroutine hd_get_tcutoff
891 subroutine hd_get_cbounds(wLC, wRC, wLp, wRp, x, ixI^L, ixO^L, idim,Hspeed,cmax, cmin)
896 integer,
intent(in) :: ixi^
l, ixo^
l, idim
898 double precision,
intent(in) :: wlc(ixi^s,
nw), wrc(ixi^s,
nw)
900 double precision,
intent(in) :: wlp(ixi^s,
nw), wrp(ixi^s,
nw)
901 double precision,
intent(in) :: x(ixi^s, 1:
ndim)
903 double precision,
intent(inout),
optional :: cmin(ixi^s,1:
number_species)
906 double precision :: wmean(ixi^s,
nw)
907 double precision,
dimension(ixI^S) :: umean, dmean, csoundl, csoundr, tmp1,tmp2,tmp3
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)
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
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)
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))
943 cmax(ixo^s,1)=dabs(umean(ixo^s))+dmean(ixo^s)
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)
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_)
955 csoundr(ixo^s) = dsqrt(csoundr(ixo^s))
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))
967 cmax(ixo^s,1)=dabs(tmp1(ixo^s))+csoundr(ixo^s)
971 call dust_get_cmax(wmean, x, ixi^l, ixo^l, idim, cmax, cmin)
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))
993 cmax(ixo^s,1)=max(wlp(ixo^s,
mom(idim)),wrp(ixo^s,
mom(idim)))+csoundl(ixo^s)
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)
1001 end subroutine hd_get_cbounds
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)
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)
1030 pth(ixo^s) = (
hd_gamma - 1.0d0) * (w(ixo^s,
e_) - &
1041 {
do ix^db= ixo^lim^db\}
1047 {
do ix^db= ixo^lim^db\}
1049 write(*,*)
"Error: small value of gas pressure",pth(ix^
d),&
1050 " encountered when call hd_get_pthermal"
1052 write(*,*)
"Location: ", x(ix^
d,:)
1053 write(*,*)
"Cell number: ", ix^
d
1055 write(*,*) trim(cons_wnames(iw)),
": ",w(ix^
d,iw)
1059 write(*,*)
"Saving status at the previous time step"
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)
1075 double precision :: r(ixi^s)
1077 call hd_get_rfactor(w,x,ixi^
l,ixo^
l,r)
1079 res(ixo^s)=res(ixo^s)/(r(ixo^s)*w(ixo^s,
rho_))
1080 end subroutine hd_get_temperature_from_etot
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)
1090 double precision :: r(ixi^s)
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
1097 subroutine hd_get_flux(wC, w, x, ixI^L, ixO^L, idim, f)
1102 integer,
intent(in) :: ixi^
l, ixo^
l, idim
1104 double precision,
intent(in) :: wc(ixi^s, 1:nw)
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)
1110 double precision :: pth(ixi^s)
1114 {
do ix^db=ixomin^db,ixomax^db\}
1124 {
do ix^db=ixomin^db,ixomax^db\}
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)
1138 call dust_get_flux_prim(w, x, ixi^l, ixo^l, idim, f)
1143 call visc_get_flux_prim(w, x, ixi^l, ixo^l, idim, f,
hd_energy)
1146 end subroutine hd_get_flux
1155 subroutine hd_add_source_geom(qdt, dtfactor, ixI^L, ixO^L, wCT, wprim, w, x)
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)
1168 double precision :: pth(ixi^s),
source(ixi^s), minrho
1169 integer :: iw,idir, h1x^
l{^nooned, h2x^
l}
1170 integer :: mr_,mphi_
1171 integer :: irho, ifluid, n_fluids
1172 double precision :: exp_factor(ixi^s), del_exp_factor(ixi^s), exp_factor_primitive(ixi^s)
1194 source(ixo^s) =
source(ixo^s)*del_exp_factor(ixo^s)/exp_factor(ixo^s)
1198 do ifluid = 0, n_fluids-1
1200 if (ifluid == 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_)
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_)
1235 w(ixo^s, mr_) = w(ixo^s, mr_) + qdt *
source(ixo^s) / x(ixo^s,
r_)
1240 call mpistop(
"Dust geom source terms not implemented yet with spherical geometries")
1244 h1x^
l=ixo^
l-
kr(1,^
d); {^nooned h2x^
l=ixo^
l-
kr(2,^
d);}
1246 pth(ixo^s)=wprim(ixo^s,
p_)
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)
1261 w(ixo^s, mr_) = w(ixo^s, mr_) + qdt *
source(ixo^s) / x(ixo^s, 1)
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)
1269 source(ixo^s) =
source(ixo^s) + (wprim(ixo^s,
mom(3))**2 * wprim(ixo^s,
rho_)) / tan(x(ixo^s, 2))
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)
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)
1287 call mpistop(
"Rotating frame not implemented yet with dust")
1293 end subroutine hd_add_source_geom
1296 subroutine hd_add_source(qdt,dtfactor, ixI^L,ixO^L,wCT,wCTprim,w,x,qsourcesplit,active)
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
1312 double precision :: gravity_field(ixi^s, 1:
ndim)
1313 integer :: idust, idim
1321 qsourcesplit,active,
rc_fl)
1340 + qdt * gravity_field(ixo^s, idim) * wct(ixo^s,
dust_rho(idust))
1351 if(.not.qsourcesplit)
then
1353 call hd_update_temperature(ixi^
l,ixo^
l,wct,w,x)
1357 end subroutine hd_add_source
1359 subroutine hd_get_dt(w, ixI^L, ixO^L, dtnew, dx^D, x)
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
1394 end subroutine hd_get_dt
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)
1403 if (
present(inv_rho))
then
1404 ke = 0.5d0 * sum(w(ixo^s,
mom(:))**2, dim=
ndim+1) * inv_rho
1406 ke = 0.5d0 * sum(w(ixo^s,
mom(:))**2, dim=
ndim+1) / w(ixo^s,
rho_)
1410 function hd_inv_rho(w, ixI^L, ixO^L)
result(inv_rho)
1412 integer,
intent(in) :: ixi^
l, ixo^
l
1413 double precision,
intent(in) :: w(ixi^s, nw)
1414 double precision :: inv_rho(ixo^s)
1417 inv_rho = 1.0d0 / w(ixo^s,
rho_)
1418 end function hd_inv_rho
1420 subroutine hd_handle_small_values(primitive, w, x, ixI^L, ixO^L, subname)
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
1434 logical :: flag(ixi^s,1:nw)
1444 where(flag(ixo^s,
rho_)) w(ixo^s,
mom(idir)) = 0.0d0
1461 where(flag(ixo^s,
e_))
1486 -0.5d0*sum(w(ixi^s,
mom(:))**2, dim=
ndim+1)/w(ixi^s,
rho_))
1489 +0.5d0*sum(w(ixi^s,
mom(:))**2, dim=
ndim+1)/w(ixi^s,
rho_)
1501 if(.not.primitive)
then
1509 w(ixo^s,
mom(idir)) = w(ixo^s,
mom(idir))/w(ixo^s,
rho_)
1516 end subroutine hd_handle_small_values
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)
1526 double precision :: iz_h(ixo^s),iz_he(ixo^s)
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
1532 end subroutine rfactor_from_temperature_ionization
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)
1543 end subroutine rfactor_from_constant_ionization
1545 subroutine hd_update_temperature(ixI^L,ixO^L,wCT,w,x)
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)
1553 double precision :: iz_h(ixo^s),iz_he(ixo^s), pth(ixi^s)
1562 end subroutine hd_update_temperature
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.
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
subroutine, public dust_evaluate_implicit(qtc, psa)
inplace update of psa==>F_im(psa)
subroutine, public dust_to_primitive(ixil, ixol, w, x)
subroutine, public dust_get_dt(w, ixil, ixol, dtnew, dxd, x)
Get dt related to dust and gas stopping time (Laibe 2011)
integer, dimension(:, :), allocatable, public, protected dust_mom
Indices of the dust momentum densities.
subroutine, public dust_to_conserved(ixil, ixol, w, x)
integer, public, protected dust_n_species
The number of dust species.
subroutine, public dust_get_flux_prim(w, x, ixil, ixol, idim, f)
subroutine, public dust_check_w(ixil, ixol, w, flag)
integer, dimension(:), allocatable, public, protected dust_rho
Indices of the dust densities.
subroutine, public dust_get_cmax(w, x, ixil, ixol, idim, cmax, cmin)
subroutine, public dust_check_params()
subroutine, public dust_get_cmax_prim(w, x, ixil, ixol, idim, cmax, cmin)
subroutine, public dust_init(g_rho, g_mom, g_energy)
subroutine, public dust_implicit_update(dtfactor, qdt, qtc, psb, psa)
Implicit solve of psb=psa+dtfactor*dt*F_im(psb)
Module for flux conservation near refinement boundaries.
Module with geometry-related routines (e.g., divergence, curl)
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 small_pressure
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
double precision small_density
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.
logical grav_split
source split or not
subroutine gravity_get_dt(w, ixil, ixol, dtnew, dxd, x)
subroutine gravity_init()
Initialize the module.
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
Hydrodynamics physics module.
integer, public, protected m
subroutine, public hd_check_params
logical, public, protected hd_energy
Whether an energy equation is used.
logical, public, protected hd_dust
Whether dust is added.
integer, public, protected e_
Index of the energy density (-1 if not present)
logical, public, protected hd_radiative_cooling
Whether radiative cooling is added.
double precision, public, protected rr
double precision, public hd_gamma
The adiabatic index.
integer, public, protected hd_trac_type
logical, public, protected hd_particles
Whether particles module is added.
type(tc_fluid), allocatable, public tc_fl
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.
integer, public, protected c
Indices of the momentum density for the form of better vectorization.
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.
double precision, public, protected he_ion_fr2
Ratio of number He2+ / number He+ + He2+ He_ion_fr2 = He2+/(He2+ + He+)
integer, public, protected te_
Indices of temperature.
integer, dimension(:), allocatable, public, protected mom
Indices of the momentum density.
double precision, public, protected h_ion_fr
Ionization fraction of H H_ion_fr = H+/(H+ + H)
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.
subroutine, public hd_phys_init()
Initialize the module.
integer, dimension(:), allocatable, public, protected tracer
Indices of the tracers.
logical, public, protected hd_thermal_conduction
Whether thermal conduction is added.
logical, public, protected eq_state_units
double precision, public hd_adiab
The adiabatic constant.
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)
logical, public, protected hd_partial_ionization
Whether plasma is partially ionized.
double precision, public, protected he_ion_fr
Ionization fraction of He He_ion_fr = (He2+ + He+)/(He2+ + He+ + He)
double precision, public, protected he_abundance
Helium abundance over Hydrogen.
logical, public, protected hd_gravity
Whether gravity is added.
integer, public, protected c_
type(rc_fluid), allocatable, public rc_fl
logical, public, protected hd_trac
Whether TRAC method is used.
integer, public, protected hd_n_tracer
Number of tracer species.
type(te_fluid), allocatable, public te_fl_hd
logical, public, protected hd_rotating_frame
Whether rotating frame is activated.
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_.
module ionization degree - get ionization degree for given temperature
subroutine ionization_degree_from_temperature(ixil, ixol, te, iz_h, iz_he)
subroutine ionization_degree_init()
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...
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)