From 007d2ef15c673617377d6d127a3c64db44cb192d Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 14:39:15 +1100 Subject: [PATCH 01/54] (utils_orbits) Fixed angular momentum calculation --- src/utils/utils_orbits.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils/utils_orbits.f90 b/src/utils/utils_orbits.f90 index a92cd3da9..502fcc331 100644 --- a/src/utils/utils_orbits.f90 +++ b/src/utils/utils_orbits.f90 @@ -65,7 +65,7 @@ function hvector(pos_vec,vel_vec) real,intent(in) :: pos_vec(3),vel_vec(3) real,dimension(3) :: hvector - call cross_product3D(vel_vec,pos_vec,hvector) + call cross_product3D(pos_vec,vel_vec,hvector) end function hvector From f6e05f5a8aa8f92e78e4024f7a42b7ef8a099ba7 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 14:48:22 +1100 Subject: [PATCH 02/54] (gr_sink) Added array size for gr sink particles --- src/main/config.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/main/config.F90 b/src/main/config.F90 index 1238e1ea6..7802c2fb9 100644 --- a/src/main/config.F90 +++ b/src/main/config.F90 @@ -262,8 +262,10 @@ module dim integer :: maxgr = 0 #ifdef GR logical, parameter :: gr = .true. + integer, parameter :: maxptmassgr = maxptmass #else logical, parameter :: gr = .false. + integer, parameter :: maxptmassgr = 0 #endif !--------------------- From 19353f545d90557404e448724c4d446f04cbf4bb Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 16:55:28 +1100 Subject: [PATCH 03/54] (gr_sink) get_accel_sink_sink works for GR case by only returning force between the sinks only --- src/main/ptmass.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/main/ptmass.F90 b/src/main/ptmass.F90 index 4f4c9f995..c20b31c70 100644 --- a/src/main/ptmass.F90 +++ b/src/main/ptmass.F90 @@ -336,23 +336,24 @@ subroutine get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,phitot,dtsinksin #ifdef FINVSQRT use fastmath, only:finvsqrt #endif + use dim, only:gr use externalforces, only:externalforce use extern_geopot, only:get_geopot_force use kernel, only:kernel_softening,radkern use vectorutils, only:unitvec use part, only:igarg,igid,icomp,ihacc,ipert integer, intent(in) :: nptmass + integer, intent(in) :: iexternalforce real, intent(in) :: xyzmh_ptmass(nsinkproperties,nptmass) + real, intent(in) :: ti real, intent(out) :: fxyz_ptmass(4,nptmass) real, intent(out) :: phitot,dtsinksink - integer, intent(in) :: iexternalforce - real, intent(in) :: ti integer, intent(out) :: merge_ij(:),merge_n real, intent(out) :: dsdt_ptmass(3,nptmass) integer, optional, intent(in) :: group_info(4,nptmass) - real, optional, intent(out) :: bin_info(6,nptmass) real, optional, intent(in) :: extrapfac real, optional, intent(in) :: fsink_old(4,nptmass) + real, optional, intent(out) :: bin_info(6,nptmass) real :: xi,yi,zi,pmassi,pmassj,hacci,haccj,fxi,fyi,fzi,phii real :: ddr,dx,dy,dz,rr2,rr2j,dr3,f1,f2 real :: hsoft1,hsoft21,q2i,qi,psoft,fsoft @@ -554,7 +555,7 @@ subroutine get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,phitot,dtsinksin ! !--apply external forces ! - if (iexternalforce > 0) then + if (iexternalforce > 0 .and. .not. gr) then call externalforce(iexternalforce,xi,yi,zi,0.,ti,fextx,fexty,fextz,phiext,ii=-i) fxi = fxi + fextx fyi = fyi + fexty @@ -595,7 +596,6 @@ subroutine get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,phitot,dtsinksin fzi = fxyz_ptmass(3,i) phii = fxyz_ptmass(4,i) f2 = fxi*fxi + fyi*fyi + fzi*fzi - !print*,'phi = ',phii,' accel = ',sqrt(f2) ! !--we use an additional tolerance here on the sink-sink timestep ! so that with the default C_force of ~0.25 we get a few From b4baa3f463be3360c27aa0586f9cf9056b79e7cd Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:10:09 +1100 Subject: [PATCH 04/54] (gr_sink) initial file calculates the force between the sink particles in GR case --- src/main/initial.F90 | 49 +++++++++++++++++++++++++++++++------------- 1 file changed, 35 insertions(+), 14 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 67b480e15..a6588743b 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -124,7 +124,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) use mpiutils, only:reduceall_mpi,barrier_mpi,reduce_in_place_mpi use dim, only:maxp,maxalpha,maxvxyzu,maxptmass,maxdusttypes,itau_alloc,itauL_alloc,& nalpha,mhd,mhd_nonideal,do_radiation,gravity,use_dust,mpi,do_nucleation,& - use_dustgrowth,ind_timesteps,idumpfile,update_muGamma,use_apr + use_dustgrowth,ind_timesteps,idumpfile,update_muGamma,use_apr,gr use deriv, only:derivs use evwrite, only:init_evfile,write_evfile,write_evlog use energies, only:compute_energies @@ -143,12 +143,14 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) nden_nimhd,dustevol,rhoh,gradh,apr_level,aprmassoftype,& Bevol,Bxyz,dustprop,filfac,ddustprop,ndustsmall,iboundary,eos_vars,dvdx, & n_group,n_ingroup,n_sing,nmatrix,group_info,bin_info,isionised - use part, only:pxyzu,dens,metrics,rad,radprop,drad,ithick + use part, only:pxyzu,dens,metrics,rad,radprop,drad,ithick,metrics_ptmass,pxyzu_ptmass,dens_ptmass,& + fext_ptmass use densityforce, only:densityiterate use linklist, only:set_linklist use boundary_dyn, only:dynamic_bdy,init_dynamic_bdy + use substepping, only:combine_forces_gr #ifdef GR - use part, only:metricderivs + use part, only:metricderivs,metricderivs_ptmass use cons2prim, only:prim2consall use eos, only:ieos use extern_gr, only:get_grforce_all,get_tmunu_all,get_tmunu_all_exact @@ -443,7 +445,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) call init_metric(npart,xyzh,metrics,metricderivs) ! -- The conserved quantites (momentum and entropy) are being computed ! -- directly from the primitive values in the starting dumpfile. - call prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens=.false.) + call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) write(iprint,*) '' call warning('initial','using preprocessor flag -DPRIM2CONS_FIRST') write(iprint,'(a,/)') ' This means doing prim2cons BEFORE the initial density calculation for this simulation.' @@ -457,11 +459,11 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) endif #ifndef PRIM2CONS_FIRST call init_metric(npart,xyzh,metrics,metricderivs) - call prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens=.false.) + call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) #endif if (iexternalforce > 0 .and. imetric /= imet_minkowski) then call initialise_externalforces(iexternalforce,ierr) - if (ierr /= 0) call fatal('initial','error in external force settings/initialisation') + if (ierr /= 0) call fatal('initial','error in external force settings/initialisation') call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtextforce) endif #else @@ -525,14 +527,33 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) if (nptmass > 0) then if (id==master) write(iprint,"(a,i12)") ' nptmass = ',nptmass if (iH2R > 0) call update_ionrates(nptmass,xyzmh_ptmass,h_acc) - ! compute initial sink-sink forces and get timestep - if (use_regnbody) then - call init_subgroup - call group_identify(nptmass,n_group,n_ingroup,n_sing,xyzmh_ptmass,vxyz_ptmass,group_info,bin_info,nmatrix) - endif - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& - iexternalforce,time,merge_ij,merge_n,dsdt_ptmass,& - group_info,bin_info) + if (.not. gr) then + ! compute initial sink-sink forces and get timestep + if (use_regnbody) then + call init_subgroup + call group_identify(nptmass,n_group,n_ingroup,n_sing,xyzmh_ptmass,vxyz_ptmass,group_info,bin_info,nmatrix) + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& + iexternalforce,ti=time,merge_ij,merge_n,dsdt_ptmass,& + group_info=group_info,bin_info=bin_info) + + else + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& + iexternalforce,ti=time,merge_ij,merge_n,dsdt_ptmass) + endif + endif +#ifdef GR + ! calculate metric derivatives and the external force caused by the metric on the sink particles + ! this will also return the timestep for sink-sink + call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) + call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& + vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,dens=dens_ptmass,use_sink=.true.) + ! sinks in GR, provide external force due to metric to determine the sink total force + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& + iexternalforce,merge_ij,merge_n,dsdt_ptmass,ti=time) + call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& + vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) + call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) +#endif dtsinksink = C_force*dtsinksink if (id==master) write(iprint,*) 'dt(sink-sink) = ',dtsinksink dtextforce = min(dtextforce,dtsinksink) From 6a0fd8b11537fed66c43500d17560785227204ad Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:11:57 +1100 Subject: [PATCH 05/54] (gr_sink) check sink GR setup is OK --- src/main/checksetup.f90 | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/main/checksetup.f90 b/src/main/checksetup.f90 index b7bcc4e3b..eacd61667 100644 --- a/src/main/checksetup.f90 +++ b/src/main/checksetup.f90 @@ -410,6 +410,10 @@ subroutine check_setup(nerror,nwarn,restart) ! if (gr) call check_gr(npart,nerror,xyzh,vxyzu) ! +!--check sink GR setup +! + if (gr) call check_gr(nptmass,nerror,xyzmh_ptmass,vxyz_ptmass) +! !--check radiation setup ! if (do_radiation) call check_setup_radiation(npart,nerror,nwarn,radprop,rad) @@ -544,12 +548,6 @@ subroutine check_setup_ptmass(nerror,nwarn,hmin) isoblate = .false. - if (gr .and. nptmass > 0) then - print*,' ERROR: nptmass = ',nptmass, ' should be = 0 for GR' - nwarn = nwarn + 1 - return - endif - if (nptmass < 0) then print*,' ERROR: nptmass = ',nptmass, ' should be >= 0 ' nerror = nerror + 1 From 2d14d1ee3064e0b1fd97c3cb55eab323c7dcb80b Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:39:43 +1100 Subject: [PATCH 06/54] (gr_sink) calculate derivs and momentum arrays for sinks in GR now --- src/main/cons2prim.f90 | 126 +++++++++++++++++++++++++++++++---------- 1 file changed, 96 insertions(+), 30 deletions(-) diff --git a/src/main/cons2prim.f90 b/src/main/cons2prim.f90 index 700734b1f..709f68cd6 100644 --- a/src/main/cons2prim.f90 +++ b/src/main/cons2prim.f90 @@ -29,7 +29,7 @@ module cons2prim ! implicit none - public :: cons2primall,cons2prim_everything + public :: cons2primall,cons2prim_everything,cons2primall_sink public :: prim2consall,prim2consi private @@ -44,17 +44,17 @@ module cons2prim ! (density,velocity,internal energy), for ALL particles !+ !---------------------------------------------------------------------- -subroutine prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens) +subroutine prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens,dens,use_sink) use part, only:isdead_or_accreted,ien_type,eos_vars,igasP,igamma,itemp use eos, only:gamma,ieos integer, intent(in) :: npart real, intent(in) :: xyzh(:,:),metrics(:,:,:,:),vxyzu(:,:) - real, intent(inout) :: dens(:) real, intent(out) :: pxyzu(:,:) - logical, intent(in), optional :: use_dens + real, intent(inout), optional :: dens(:) + logical, intent(in), optional :: use_dens, use_sink logical :: usedens - integer :: i - real :: pri,tempi + integer :: i,loop_no + real :: pri,tempi,xyzhi(4),vxyzui(4) ! By default, use the smoothing length to compute primitive density, and then compute the conserved variables. ! (Alternatively, use the provided primitive density to compute conserved variables. @@ -64,26 +64,37 @@ subroutine prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens) else usedens = .false. endif - -!$omp parallel do default (none) & -!$omp shared(xyzh,metrics,vxyzu,dens,pxyzu,npart,usedens,ien_type,eos_vars,gamma,ieos) & -!$omp private(i,pri,tempi) + + !$omp parallel do default (none) & + !$omp shared(xyzh,metrics,vxyzu,dens,pxyzu,npart,usedens,ien_type,eos_vars,gamma,ieos,use_sink,use_dens) & + !$omp private(i,pri,tempi,xyzhi,vxyzui) do i=1,npart - if (.not.isdead_or_accreted(xyzh(4,i))) then - call prim2consi(xyzh(:,i),metrics(:,:,:,i),vxyzu(:,i),dens(i),pri,tempi,pxyzu(:,i),usedens,ien_type) - ! save eos vars for later use - eos_vars(igasP,i) = pri - eos_vars(itemp,i) = tempi - if (vxyzu(4,i) > 0. .and. ieos == 12) then - eos_vars(igamma,i) = 1. + pri/(dens(i)*vxyzu(4,i)) - else - ! prevent getting NaN or Infinity when u = 0 - eos_vars(igamma,i) = gamma + if (present(use_sink)) then + xyzhi(1:3) = xyzh(1:3,i) ! save positions + xyzhi(4) = xyzh(5,i) ! save smoothing length, h + vxyzui(1:3) = vxyzu(1:3,i) + vxyzui(4) = 0. ! assume energy as 0. for sink + call prim2consi(xyzhi,metrics(:,:,:,i),vxyzui,pri,tempi,pxyzu(:,i),ien_type,& + use_sink=use_sink,dens_i=dens(i)) ! this returns temperature and pressure as 0. + else + if (.not.isdead_or_accreted(xyzh(4,i))) then + call prim2consi(xyzh(:,i),metrics(:,:,:,i),vxyzu(:,i),pri,tempi,pxyzu(:,i),ien_type,& + use_dens=usedens,dens_i=dens(i)) + + ! save eos vars for later use + eos_vars(igasP,i) = pri + eos_vars(itemp,i) = tempi + if (vxyzu(4,i) > 0. .and. ieos == 12) then + eos_vars(igamma,i) = 1. + pri/(dens(i)*vxyzu(4,i)) + else + ! prevent getting NaN or Infinity when u = 0 + eos_vars(igamma,i) = gamma + endif endif - endif + endif enddo -!$omp end parallel do + !$omp end parallel do end subroutine prim2consall @@ -93,19 +104,20 @@ end subroutine prim2consall ! for a single SPH particle !+ !---------------------------------------------------------------------- -subroutine prim2consi(xyzhi,metrici,vxyzui,dens_i,pri,tempi,pxyzui,use_dens,ien_type) +subroutine prim2consi(xyzhi,metrici,vxyzui,pri,tempi,pxyzui,ien_type,use_dens,use_sink,dens_i) use cons2primsolver, only:primitive2conservative use utils_gr, only:h2dens use eos, only:equationofstate,ieos real, dimension(4), intent(in) :: xyzhi, vxyzui real, intent(in) :: metrici(:,:,:) - real, intent(inout) :: dens_i,pri,tempi + real, intent(inout) :: pri,tempi integer, intent(in) :: ien_type real, dimension(4), intent(out) :: pxyzui - logical, intent(in), optional :: use_dens + logical, intent(in), optional :: use_dens,use_sink + real, intent(inout), optional :: dens_i logical :: usedens real :: rhoi,ui,xyzi(1:3),vi(1:3),pondensi,spsoundi,densi - + ! By default, use the smoothing length to compute primitive density, and then compute the conserved variables. ! (Alternatively, use the provided primitive density to compute conserved variables. ! Depends whether you have prim dens prior or not.) @@ -118,13 +130,21 @@ subroutine prim2consi(xyzhi,metrici,vxyzui,dens_i,pri,tempi,pxyzui,use_dens,ien_ xyzi = xyzhi(1:3) vi = vxyzui(1:3) ui = vxyzui(4) + if (usedens) then densi = dens_i else - call h2dens(densi,xyzhi,metrici,vi) ! Compute dens from h - dens_i = densi ! Feed the newly computed dens back out of the routine + if (present(use_sink)) then + densi = 1. ! using a value of 0. results in NaN values for the pxyzui array. + dens_i = densi ! we do not call EOS for sinks. + pondensi = 0. + else + call h2dens(densi,xyzhi,metrici,vi) ! Compute dens from h + dens_i = densi ! Feed the newly computed dens back out of the routine + call equationofstate(ieos,pondensi,spsoundi,densi,xyzi(1),xyzi(2),xyzi(3),tempi,ui) + endif endif - call equationofstate(ieos,pondensi,spsoundi,densi,xyzi(1),xyzi(2),xyzi(3),tempi,ui) + pri = pondensi*densi call primitive2conservative(xyzi,metrici,vi,densi,ui,pri,rhoi,pxyzui(1:3),pxyzui(4),ien_type) @@ -173,7 +193,6 @@ subroutine cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) call conservative2primitive(xyzh(1:3,i),metrics(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i), & p_guess,tempi,gammai,rhoi,pxyzu(1:3,i),pxyzu(4,i),ierr,ien_type) - ! store results eos_vars(igasP,i) = p_guess eos_vars(ics,i) = get_spsound(ieos,xyzh(1:3,i),dens(i),vxyzu(:,i),gammai) @@ -191,6 +210,53 @@ subroutine cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) end subroutine cons2primall +!---------------------------------------------------------------------- +!+ +! Conservative to primitive routines (for GR sink particles): +! Solve for primitive variables (density,velocity,internal energy) +! from the evolved/conservative variables (rho*,momentum,entropy) +!+ +!---------------------------------------------------------------------- +subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) + use cons2primsolver, only:conservative2primitive + use part, only:isdead_or_accreted,massoftype,igas,rhoh,igasP,ics,ien_type,& + itemp,igamma + use io, only:fatal + use eos, only:ieos,done_init_eos,init_eos,get_spsound + integer, intent(in) :: npart + real, intent(in) :: pxyzu(:,:),xyzh(:,:),metrics(:,:,:,:) + real, intent(inout) :: vxyzu(:,:),dens(:) + real, intent(out), optional :: eos_vars(:,:) + integer :: i, ierr + real :: p_guess,rhoi,tempi,gammai,eni + + if (.not.done_init_eos) call init_eos(ieos,ierr) + +!$omp parallel do default (none) & +!$omp shared(xyzh,metrics,vxyzu,dens,pxyzu,npart,massoftype) & +!$omp shared(ieos,eos_vars,ien_type) & +!$omp private(i,ierr,p_guess,rhoi,tempi,gammai,eni) + do i=1,npart + p_guess = 0. + tempi = 0. + gammai = 0. + rhoi = 1. + ! conservative 2 primitive + call conservative2primitive(xyzh(1:3,i),metrics(:,:,:,i),vxyzu(1:3,i),dens(i),eni, & + p_guess,tempi,gammai,rhoi,pxyzu(1:3,i),pxyzu(4,i),ierr,ien_type) + + if (ierr > 0) then + print*,' pmom =',pxyzu(1:3,i) + print*,' rho* =',rhoi + print*,' en =',eni + call fatal('cons2prim','could not solve rootfinding',i) + endif + + enddo +!$omp end parallel do + +end subroutine cons2primall_sink + !----------------------------------------------------------------------------- !+ ! Solve for primitive variables (v,u,P,B,dustfrac) from evolved variables From 32a8e9a4c4431e4c35a05512c58cfae4a2e999a9 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:41:13 +1100 Subject: [PATCH 07/54] (gr_sink) dens is an optional argument --- src/main/deriv.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/main/deriv.F90 b/src/main/deriv.F90 index cd7149405..a906cc74e 100644 --- a/src/main/deriv.F90 +++ b/src/main/deriv.F90 @@ -221,6 +221,7 @@ end subroutine derivs ! this should NOT be called during timestepping, it is useful ! for when one requires just a single call to evaluate derivatives ! and store them in the global shared arrays +! does not work for sink GR yet !+ !-------------------------------------- subroutine get_derivs_global(tused,dt_new,dt) @@ -246,7 +247,7 @@ subroutine get_derivs_global(tused,dt_new,dt) ! update conserved quantities in the GR code if (gr) then call init_metric(npart,xyzh,metrics) - call prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens=.false.) + call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) endif ! evaluate derivatives From c5af2e538dc3465c62a46516d5c110940137df04 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:41:57 +1100 Subject: [PATCH 08/54] (gr_sink) calculate energies for the GR sink case --- src/main/energies.F90 | 155 +++++++++++++++++++++++++++++------------- 1 file changed, 108 insertions(+), 47 deletions(-) diff --git a/src/main/energies.F90 b/src/main/energies.F90 index acea5414a..5d5d69872 100644 --- a/src/main/energies.F90 +++ b/src/main/energies.F90 @@ -73,8 +73,8 @@ subroutine compute_energies(t) isdead_or_accreted,epot_sinksink,imacc,ispinx,ispiny,& ispinz,mhd,gravity,poten,dustfrac,eos_vars,itemp,igasP,ics,& nden_nimhd,eta_nimhd,iion,ndustsmall,graindens,grainsize,& - iamdust,ndusttypes,rad,iradxi,gtgrad,group_info,bin_info,n_group - use part, only:pxyzu,fxyzu,fext,apr_level,aprmassoftype + iamdust,ndusttypes,rad,iradxi,gtgrad,group_info,bin_info,n_group + use part, only:pxyzu,fxyzu,fext,apr_level,aprmassoftype,pxyzu_ptmass use gravwaveutils, only:calculate_strain,calc_gravitwaves use centreofmass, only:get_centreofmass_accel use eos, only:polyk,gamma,eos_is_non_ideal,eos_outputs_gasP @@ -91,7 +91,7 @@ subroutine compute_energies(t) use boundary_dyn, only:dynamic_bdy,find_dynamic_boundaries use kernel, only:radkern use timestep, only:dtmax - use part, only:metrics + use part, only:metrics,metrics_ptmass use metric_tools, only:unpack_metric use utils_gr, only:dot_product_gr,get_geodesic_accel use vectorutils, only:cross_product3D @@ -183,7 +183,7 @@ subroutine compute_energies(t) !$omp shared(iev_B,iev_divB,iev_hdivB,iev_beta,iev_temp,iev_etao,iev_etah) & !$omp shared(iev_etaa,iev_vel,iev_vhall,iev_vion,iev_n) & !$omp shared(iev_dtg,iev_ts,iev_macc,iev_totlum,iev_erot,iev_viscrat) & -!$omp shared(eos_vars,grainsize,graindens,ndustsmall,metrics) & +!$omp shared(eos_vars,grainsize,graindens,ndustsmall,metrics,metrics_ptmass,pxyzu_ptmass) & !$omp private(i,j,xi,yi,zi,hi,rhoi,vxi,vyi,vzi,Bxi,Byi,Bzi,Bi,B2i,epoti,vsigi,v2i) & !$omp private(ponrhoi,spsoundi,gammai,dumx,dumy,dumz,valfven2i,divBi,hdivBonBi,curlBi) & !$omp private(rho1i,shearparam_art,shearparam_phys,ratio_phys_to_av,betai) & @@ -566,49 +566,110 @@ subroutine compute_energies(t) !--add contribution from sink particles ! if (id==master) then - !$omp do - do i=1,nptmass - xi = xyzmh_ptmass(1,i) - yi = xyzmh_ptmass(2,i) - zi = xyzmh_ptmass(3,i) - pmassi = xyzmh_ptmass(4,i) - if (pmassi < 0.) cycle - - vxi = vxyz_ptmass(1,i) - vyi = vxyz_ptmass(2,i) - vzi = vxyz_ptmass(3,i) - - !phii = fxyz_ptmass(4,i) - - xcom = xcom + pmassi*xi - ycom = ycom + pmassi*yi - zcom = zcom + pmassi*zi - mtot = mtot + pmassi - - xmom = xmom + pmassi*vxi - ymom = ymom + pmassi*vyi - zmom = zmom + pmassi*vzi - - angx = angx + pmassi*(yi*vzi - zi*vyi) - angy = angy + pmassi*(zi*vxi - xi*vzi) - angz = angz + pmassi*(xi*vyi - yi*vxi) - - angx = angx + xyzmh_ptmass(ispinx,i) - angy = angy + xyzmh_ptmass(ispiny,i) - angz = angz + xyzmh_ptmass(ispinz,i) - - v2i = vxi*vxi + vyi*vyi + vzi*vzi - ekin = ekin + pmassi*v2i - - ! rotational energy around each axis through the origin - if (calc_erot) then - call get_erot(xi,yi,zi,vxi,vyi,vzi,xyzcom,pmassi,erotxi,erotyi,erotzi) - call ev_data_update(ev_data_thread,iev_erot(1),erotxi) - call ev_data_update(ev_data_thread,iev_erot(2),erotyi) - call ev_data_update(ev_data_thread,iev_erot(3),erotzi) - endif - enddo - !$omp enddo + + if (.not. gr) then + !$omp do + do i=1,nptmass + xi = xyzmh_ptmass(1,i) + yi = xyzmh_ptmass(2,i) + zi = xyzmh_ptmass(3,i) + pmassi = xyzmh_ptmass(4,i) + if (pmassi < 0.) cycle + + vxi = vxyz_ptmass(1,i) + vyi = vxyz_ptmass(2,i) + vzi = vxyz_ptmass(3,i) + + !phii = fxyz_ptmass(4,i) + + xcom = xcom + pmassi*xi + ycom = ycom + pmassi*yi + zcom = zcom + pmassi*zi + mtot = mtot + pmassi + + xmom = xmom + pmassi*vxi + ymom = ymom + pmassi*vyi + zmom = zmom + pmassi*vzi + + angx = angx + pmassi*(yi*vzi - zi*vyi) + angy = angy + pmassi*(zi*vxi - xi*vzi) + angz = angz + pmassi*(xi*vyi - yi*vxi) + + angx = angx + xyzmh_ptmass(ispinx,i) + angy = angy + xyzmh_ptmass(ispiny,i) + angz = angz + xyzmh_ptmass(ispinz,i) + + v2i = vxi*vxi + vyi*vyi + vzi*vzi + ekin = ekin + pmassi*v2i + + + ! rotational energy around each axis through the origin + if (calc_erot) then + call get_erot(xi,yi,zi,vxi,vyi,vzi,xyzcom,pmassi,erotxi,erotyi,erotzi) + call ev_data_update(ev_data_thread,iev_erot(1),erotxi) + call ev_data_update(ev_data_thread,iev_erot(2),erotyi) + call ev_data_update(ev_data_thread,iev_erot(3),erotzi) + endif + enddo + !$omp enddo + else + !$omp do + do i=1,nptmass + ! calculate Kinetic and thermal energy for the GR-sink case. + xi = xyzmh_ptmass(1,i) + yi = xyzmh_ptmass(2,i) + zi = xyzmh_ptmass(3,i) + pmassi = xyzmh_ptmass(4,i) + if (pmassi < 0.) cycle + + vxi = vxyz_ptmass(1,i) + vyi = vxyz_ptmass(2,i) + vzi = vxyz_ptmass(3,i) + + pxi = pxyzu_ptmass(1,i) + pyi = pxyzu_ptmass(2,i) + pzi = pxyzu_ptmass(3,i) + + + mtot = mtot + pmassi + + call unpack_metric(metrics_ptmass(:,:,:,i),betaUP=beta_gr_UP,alpha=alpha_gr,gammaijdown=gammaijdown) + bigvi = (vxyz_ptmass(1:3,i)+beta_gr_UP)/alpha_gr + v2i = dot_product_gr(bigvi,bigvi,gammaijdown) + lorentzi = 1./sqrt(1.-v2i) + pdotv = pxi*vxi + pyi*vyi + pzi*vzi + + ! angular momentum + fourvel_space = (lorentzi/alpha_gr)*vxyz_ptmass(1:3,i) + call cross_product3D(xyzmh_ptmass(1:3,i),fourvel_space,angi) ! position cross with four-velocity + + ! kinetic energy + ekini = pmassi*(pdotv + alpha_gr/lorentzi - 1.) ! The 'kinetic term' in total specific energy, minus rest mass + + ! kinetic energy & rms velocity + ekin = ekin + ekini + vrms = vrms + v2i + + ! linear momentum + xmom = xmom + pmassi*pxi + ymom = ymom + pmassi*pyi + zmom = zmom + pmassi*pzi + + ! angular momentum + angx = angx + pmassi*angi(1) + angy = angy + pmassi*angi(2) + angz = angz + pmassi*angi(3) + + ! rotational energy around each axis through the origin + if (calc_erot) then + call get_erot(xi,yi,zi,vxi,vyi,vzi,xyzcom,pmassi,erotxi,erotyi,erotzi) + call ev_data_update(ev_data_thread,iev_erot(1),erotxi) + call ev_data_update(ev_data_thread,iev_erot(2),erotyi) + call ev_data_update(ev_data_thread,iev_erot(3),erotzi) + endif + enddo + !$omp enddo + endif endif !$omp critical(collatedata) From ed6eef981737ffcb4afb05622737d157f208ed7e Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:43:10 +1100 Subject: [PATCH 09/54] (gr_sink) calculate grforce_all for GR sinks --- src/main/extern_gr.f90 | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/src/main/extern_gr.f90 b/src/main/extern_gr.f90 index 7043299e2..687c30768 100644 --- a/src/main/extern_gr.f90 +++ b/src/main/extern_gr.f90 @@ -58,7 +58,7 @@ end subroutine get_grforce ! gradients on all particles !+ !--------------------------------------------------------------- -subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtexternal) +subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtexternal,use_sink) use timestep, only:C_force use eos, only:ieos,get_pressure use part, only:isdead_or_accreted @@ -66,21 +66,36 @@ subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtext real, intent(in) :: xyzh(:,:), metrics(:,:,:,:), metricderivs(:,:,:,:), dens(:) real, intent(inout) :: vxyzu(:,:) real, intent(out) :: fext(:,:), dtexternal + logical, intent(in), optional :: use_sink ! we pick the data from the xyzh array and assume u=0 for this case integer :: i real :: dtf,pi + real :: xyzhi(4),vxyzui(4) dtexternal = huge(dtexternal) !$omp parallel do default(none) & - !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,ieos,C_force) & - !$omp private(i,dtf,pi) & + !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,ieos,C_force,use_sink) & + !$omp private(i,dtf,pi,xyzhi,vxyzui) & !$omp reduction(min:dtexternal) do i=1,npart - if (.not.isdead_or_accreted(xyzh(4,i))) then - pi = get_pressure(ieos,xyzh(:,i),dens(i),vxyzu(:,i)) - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pi,fext(1:3,i),dtf) + if (present(use_sink)) then + + xyzhi(1:3) = xyzh(1:3,i) + xyzhi(4) = xyzh(5,i) ! save smoothing length, h + vxyzui(1:3) = vxyzu(1:3,i) + vxyzui(4) = 0. + pi = 0. + call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzui(1:3),dens(i),vxyzui(4),pi,fext(1:3,i),dtf) dtexternal = min(dtexternal,C_force*dtf) - endif + + else + + if (.not.isdead_or_accreted(xyzh(4,i))) then + pi = get_pressure(ieos,xyzh(:,i),dens(i),vxyzu(:,i)) + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pi,fext(1:3,i),dtf) + dtexternal = min(dtexternal,C_force*dtf) + endif + endif enddo !$omp end parallel do From b8158ee20c2a0fc430e6f5104676c2d0241064f2 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 5 Dec 2024 17:49:05 +1100 Subject: [PATCH 10/54] (gr_sink) calculate the initial gr force --- src/main/initial.F90 | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index a6588743b..1d7e2ba7c 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -532,15 +532,10 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) if (use_regnbody) then call init_subgroup call group_identify(nptmass,n_group,n_ingroup,n_sing,xyzmh_ptmass,vxyz_ptmass,group_info,bin_info,nmatrix) - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& - iexternalforce,ti=time,merge_ij,merge_n,dsdt_ptmass,& - group_info=group_info,bin_info=bin_info) - - else - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& - iexternalforce,ti=time,merge_ij,merge_n,dsdt_ptmass) endif - endif + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& + iexternalforce,time,merge_ij,merge_n,dsdt_ptmass,& + group_info,bin_info) #ifdef GR ! calculate metric derivatives and the external force caused by the metric on the sink particles ! this will also return the timestep for sink-sink @@ -549,7 +544,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,dens=dens_ptmass,use_sink=.true.) ! sinks in GR, provide external force due to metric to determine the sink total force call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& - iexternalforce,merge_ij,merge_n,dsdt_ptmass,ti=time) + iexternalforce,time,merge_ij,merge_n,dsdt_ptmass) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) From 498153db9f9fe30351dad4b4baa3a6b3618c265f Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:26:10 +1100 Subject: [PATCH 11/54] (gr_sink) initialise arrays for GR sink --- src/main/part.F90 | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/src/main/part.F90 b/src/main/part.F90 index 6f7655daa..6d4b8e414 100644 --- a/src/main/part.F90 +++ b/src/main/part.F90 @@ -33,7 +33,7 @@ module part maxphase,maxgradh,maxan,maxdustan,maxmhdan,maxneigh,maxprad,maxp_nucleation,& maxTdust,store_dust_temperature,use_krome,maxp_krome, & do_radiation,gr,maxgr,maxgran,n_nden_phantom,do_nucleation,& - inucleation,itau_alloc,itauL_alloc,use_apr,apr_maxlevel,maxp_apr + inucleation,itau_alloc,itauL_alloc,use_apr,apr_maxlevel,maxp_apr,maxptmassgr use dtypekdtree, only:kdnode #ifdef KROME use krome_user, only: krome_nmols @@ -159,6 +159,7 @@ module part maxeosvars = 7 character(len=*), parameter :: eos_vars_label(maxeosvars) = & (/'pressure ','sound speed','temperature','mu ','H fraction ','metallicity','gamma '/) + ! !--energy_variables ! @@ -187,6 +188,14 @@ module part real, allocatable :: tmunus(:,:,:) !tmunus(0:3,0:3,maxgr) real, allocatable :: sqrtgs(:) ! sqrtg(maxgr) ! +!--sink particles in General relativity +! + real, allocatable :: pxyzu_ptmass(:,:) !pxyz_ptmass(maxvxyzu,maxgr) + real, allocatable :: dens_ptmass(:) + real, allocatable :: metrics_ptmass(:,:,:,:) !metrics(0:3,0:3,2,maxgr) + real, allocatable :: metricderivs_ptmass(:,:,:,:) !metricderivs(0:3,0:3,3,maxgr) + real, allocatable :: fext_ptmass(:,:) +! !--sink particles ! integer, parameter :: ihacc = 5 ! accretion radius @@ -473,6 +482,11 @@ subroutine allocate_part call allocate_array('metricderivs', metricderivs, 4, 4, 3, maxgr) call allocate_array('tmunus', tmunus, 4, 4, maxgr) call allocate_array('sqrtgs', sqrtgs, maxgr) + call allocate_array('pxyzu_ptmass', pxyzu_ptmass, maxvxyzu, maxptmassgr) + call allocate_array('dens_ptmass', dens_ptmass, maxptmassgr) + call allocate_array('metrics_ptmass', metrics_ptmass, 4, 4, 2, maxptmassgr) + call allocate_array('metricderivs_ptmass', metricderivs_ptmass, 4, 4, 3, maxptmassgr) + call allocate_array('fext_ptmass', fext_ptmass, 4, maxptmassgr) call allocate_array('xyzmh_ptmass', xyzmh_ptmass, nsinkproperties, maxptmass) call allocate_array('vxyz_ptmass', vxyz_ptmass, 3, maxptmass) call allocate_array('fxyz_ptmass', fxyz_ptmass, 4, maxptmass) @@ -567,6 +581,11 @@ subroutine deallocate_part if (allocated(metricderivs)) deallocate(metricderivs) if (allocated(tmunus)) deallocate(tmunus) if (allocated(sqrtgs)) deallocate(sqrtgs) + if (allocated(pxyzu_ptmass)) deallocate(pxyzu_ptmass) + if (allocated(dens_ptmass)) deallocate(dens_ptmass) + if (allocated(metrics_ptmass)) deallocate(metrics_ptmass) + if (allocated(metricderivs_ptmass)) deallocate(metricderivs_ptmass) + if (allocated(fext_ptmass)) deallocate(fext_ptmass) if (allocated(xyzmh_ptmass)) deallocate(xyzmh_ptmass) if (allocated(vxyz_ptmass)) deallocate(vxyz_ptmass) if (allocated(fxyz_ptmass)) deallocate(fxyz_ptmass) From fea083d538d1afeba6c28c465e84457435e1f2f3 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:27:07 +1100 Subject: [PATCH 12/54] (gr_sink) edited prim2consall because dens is an optional argument now --- src/main/partinject.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/partinject.F90 b/src/main/partinject.F90 index 697a46be1..b41b64fe9 100644 --- a/src/main/partinject.F90 +++ b/src/main/partinject.F90 @@ -168,7 +168,7 @@ end subroutine add_or_update_sink subroutine update_injected_particles(npartold,npart,istepfrac,nbinmax,time,dtmax,dt,dtinject) use dim, only:ind_timesteps use timestep_ind, only:get_newbin,change_nbinmax,get_dt - use part, only:twas,ibin,ibin_old,iphase,igas,iunknown + use part, only:twas,ibin,ibin_old,iphase,igas,iunknown,nptmass #ifdef GR use part, only:xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext use cons2prim, only:prim2consall @@ -196,7 +196,7 @@ subroutine update_injected_particles(npartold,npart,istepfrac,nbinmax,time,dtmax ! after injecting particles, reinitialise metrics on all particles ! call init_metric(npart,xyzh,metrics,metricderivs) - call prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens=.false.) + call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) if (iexternalforce > 0 .and. imetric /= imet_minkowski) then call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtext_dum) ! Not 100% sure if this is needed here endif From 3af458d7058e1ba0915f5846bb71bb5a5929ec06 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:28:29 +1100 Subject: [PATCH 13/54] (gr_sink) substepping for GR sink particles --- src/main/step_leapfrog.F90 | 32 +++++++++++++++++++++++++++----- 1 file changed, 27 insertions(+), 5 deletions(-) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index a399f495b..e42d9d3e3 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -98,13 +98,15 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) iamboundary,get_ntypes,npartoftypetot,apr_level,& dustfrac,dustevol,ddustevol,eos_vars,alphaind,nptmass,& dustprop,ddustprop,dustproppred,pxyzu,dens,metrics,ics,& - filfac,filfacpred,mprev,filfacprev,aprmassoftype,isionised + filfac,filfacpred,mprev,filfacprev,aprmassoftype,isionised,epot_sinksink,& + fext_ptmass use options, only:avdecayconst,alpha,ieos,alphamax use deriv, only:derivs use timestep, only:dterr,bignumber,tolv use mpiutils, only:reduceall_mpi use part, only:nptmass,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass, & - dsdt_ptmass,fsink_old,ibin_wake,dptmass,linklist_ptmass + dsdt_ptmass,fsink_old,ibin_wake,dptmass,linklist_ptmass, & + pxyzu_ptmass,metrics_ptmass,dens_ptmass use part, only:n_group,n_ingroup,n_sing,gtgrad,group_info,bin_info,nmatrix use io_summary, only:summary_printout,summary_variable,iosumtvi,iowake, & iosumflrp,iosumflrps,iosumflrc @@ -113,9 +115,9 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) use timestep_ind, only:get_dt,nbinmax,decrease_dtmax,dt_too_small use timestep_sts, only:sts_get_dtau_next,use_sts,ibin_sts,sts_it_n use part, only:ibin,ibin_old,twas,iactive,ibin_wake - use part, only:metricderivs + use part, only:metricderivs,metricderivs_ptmass use metric_tools, only:imet_minkowski,imetric - use cons2prim, only:cons2primall + use cons2prim, only:cons2primall,cons2primall_sink use extern_gr, only:get_grforce_all use cooling, only:ufloor,cooling_in_step use timing, only:increment_timer,get_timings,itimer_substep @@ -125,7 +127,8 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) use damping, only:idamp use cons2primsolver, only:conservative2primitive,primitive2conservative use substepping, only:substep,substep_gr, & - substep_sph_gr,substep_sph + substep_sph_gr,substep_sph,combine_forces_gr + use ptmass, only:get_accel_sink_sink integer, intent(inout) :: npart integer, intent(in) :: nactive @@ -137,6 +140,9 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) real :: vxi,vyi,vzi,eni,hdtsph,pmassi real :: alphaloci,source,tdecay1,hi,rhoi,ddenom,spsoundi real :: v2mean,hdti + real :: dtsinksink + integer :: merge_ij(nptmass) + integer :: merge_n real(kind=4) :: t1,t2,tcpu1,tcpu2 real :: pxi,pyi,pzi,p2i,p2mean real :: dtsph_next,dti,time_now @@ -238,6 +244,22 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) !---------------------------------------------------------------------- call get_timings(t1,tcpu1) if (gr) then + if (nptmass > 0) then + + call cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass,dens_ptmass) + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& + iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) + call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& + vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) + call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) + + ! for now use the minimum of the two timesteps as dtextforce + dtextforce = min(dtextforce, dtsinksink) + + ! perform substepping for the sink particles + call substep_gr(nptmass,ntypes,dtsph,dtextforce,xyzmh_ptmass,vxyz_ptmass,& + pxyzu_ptmass,dens_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass,time=t,use_sink=.true.) + endif if ((iexternalforce > 0 .and. imetric /= imet_minkowski) .or. idamp > 0) then call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtextforce) From a661596296f27a9f7a62cd45a9ad8d95447c7a87 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:29:40 +1100 Subject: [PATCH 14/54] (gr_sink) substep_gr works for sinks in GR --- src/main/substepping.F90 | 767 +++++++++++++++++++++++++++++---------- 1 file changed, 579 insertions(+), 188 deletions(-) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 08f5d88a5..bdc142678 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -38,6 +38,7 @@ module substepping public :: substep_sph_gr public :: substep public :: get_force + public :: combine_forces_gr,combine_forces_gr_one private @@ -109,8 +110,8 @@ subroutine substep_sph_gr(dt,npart,xyzh,vxyzu,dens,pxyzu,metrics) end subroutine substep_sph_gr -subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time) - use dim, only:maxptmass,maxp,maxvxyzu,use_apr +subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time,use_sink) + use dim, only:maxptmass,maxvxyzu,use_apr use io, only:iverbose,id,master,iprint,warning,fatal use externalforces, only:externalforce,accrete_particles,update_externalforce use options, only:iexternalforce @@ -118,29 +119,28 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& aprmassoftype,apr_level use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete - use timestep, only:bignumber,C_force,xtol,ptol - use eos, only:equationofstate,ieos + use timestep, only:bignumber + use eos, only:equationofstate use cons2primsolver,only:conservative2primitive use extern_gr, only:get_grforce use metric_tools, only:pack_metric,pack_metricderivs - use damping, only:calc_damp,apply_damp,idamp + use damping, only:calc_damp,apply_damp integer, intent(in) :: npart,ntypes real, intent(in) :: dtsph,time real, intent(inout) :: dtextforce real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - integer :: i,itype,nsubsteps,naccreted,its,ierr,nlive + logical, intent(in), optional :: use_sink + integer :: itype,nsubsteps,naccreted,nlive real :: timei,t_end_step,hdt,pmassi - real :: dt,dtf,dtextforcenew,dtextforce_min - real :: pri,spsoundi,pondensi,tempi,gammai + real :: dt,dtextforcenew,dtextforce_min real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) - real :: x_err,pmom_err,accretedmass,damp_fac + real :: accretedmass,damp_fac ! real, save :: dmdt = 0. - logical :: last_step,done,converged,accreted + logical :: last_step,done integer, parameter :: itsmax = 50 integer :: pitsmax,xitsmax - real :: perrmax,xerrmax - real :: rhoi,hi,eni,uui,densi + real :: perrmax,xerrmax pitsmax = 0 xitsmax = 0 @@ -176,127 +176,17 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric if (.not.last_step .and. iverbose > 1 .and. id==master) then write(iprint,"(a,f14.6)") '> external forces only : t=',timei endif - !--------------------------- - ! predictor during substeps - !--------------------------- - ! - ! predictor step for external forces, also recompute external forces - ! - !$omp parallel do default(none) & - !$omp shared(npart,xyzh,vxyzu,fext,iphase,ntypes,massoftype) & - !$omp shared(maxphase,maxp,eos_vars,aprmassoftype,apr_level) & - !$omp shared(dt,hdt,xtol,ptol) & - !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & - !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi) & - !$omp private(converged,pmom_err,x_err,pri,ierr,gammai) & - !$omp firstprivate(pmassi,itype) & - !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & - !$omp reduction(min:dtextforcenew) - predictor: do i=1,npart - xyz(1) = xyzh(1,i) - xyz(2) = xyzh(2,i) - xyz(3) = xyzh(3,i) - hi = xyzh(4,i) - if (.not.isdead_or_accreted(hi)) then - if (ntypes > 1 .and. maxphase==maxp) then - itype = iamtype(iphase(i)) - if (use_apr) then - pmassi = aprmassoftype(itype,apr_level(i)) - else - pmassi = massoftype(itype) - endif - elseif (use_apr) then - pmassi = aprmassoftype(igas,apr_level(i)) - endif - - its = 0 - converged = .false. - ! - ! make local copies of array quantities - ! - pxyz(1:3) = pxyzu(1:3,i) - eni = pxyzu(4,i) - vxyz(1:3) = vxyzu(1:3,i) - uui = vxyzu(4,i) - fexti = fext(:,i) - - pxyz = pxyz + hdt*fexti - - !-- unpack thermo variables for the first guess in cons2prim - densi = dens(i) - pri = eos_vars(igasP,i) - gammai = eos_vars(igamma,i) - tempi = eos_vars(itemp,i) - rhoi = rhoh(hi,massoftype(igas)) - - ! Note: grforce needs derivatives of the metric, - ! which do not change between pmom iterations - pmom_iterations: do while (its <= itsmax .and. .not. converged) - its = its + 1 - pprev = pxyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& - tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - pxyz = pprev + hdt*(fstar - fexti) - pmom_err = maxval(abs(pxyz - pprev)) - if (pmom_err < ptol) converged = .true. - fexti = fstar - enddo pmom_iterations - if (its > itsmax ) call warning('substep_gr',& - 'max # of pmom iterations',var='pmom_err',val=pmom_err) - pitsmax = max(its,pitsmax) - perrmax = max(pmom_err,perrmax) - - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& - gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) - xyz = xyz + dt*vxyz - call pack_metric(xyz,metrics(:,:,:,i)) - - its = 0 - converged = .false. - vxyz_star = vxyz - ! Note: since particle positions change between iterations - ! the metric and its derivatives need to be updated. - ! cons2prim does not require derivatives of the metric, - ! so those can updated once the iterations are complete - ! in order to reduce the number of computations. - xyz_iterations: do while (its <= itsmax .and. .not. converged) - its = its+1 - xyz_prev = xyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& - pri,tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) - xyz = xyz_prev + hdt*(vxyz_star - vxyz) - x_err = maxval(abs(xyz-xyz_prev)) - if (x_err < xtol) converged = .true. - vxyz = vxyz_star - ! UPDATE METRIC HERE - call pack_metric(xyz,metrics(:,:,:,i)) - enddo xyz_iterations - call pack_metricderivs(xyz,metricderivs(:,:,:,i)) - if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) - xitsmax = max(its,xitsmax) - xerrmax = max(x_err,xerrmax) - - ! re-pack arrays back where they belong - xyzh(1:3,i) = xyz(1:3) - pxyzu(1:3,i) = pxyz(1:3) - vxyzu(1:3,i) = vxyz(1:3) - vxyzu(4,i) = uui - fext(:,i) = fexti - dens(i) = densi - eos_vars(igasP,i) = pri - eos_vars(itemp,i) = tempi - eos_vars(igamma,i) = gammai - - ! Skip remainder of update if boundary particle; note that fext==0 for these particles - if (iamboundary(itype)) cycle predictor - endif - enddo predictor - !$omp end parallel do - + + if (present(use_sink)) then + call predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & + dens,metrics,metricderivs,pitsmax,perrmax, & + xitsmax,xerrmax,dtextforcenew) + else + call predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & + dens,metrics,metricderivs,pitsmax,perrmax, & + xitsmax,xerrmax,dtextforcenew) + endif + if (iverbose >= 2 .and. id==master) then write(iprint,*) '------ Iterations summary: -------------------------------' write(iprint,"(a,i2,a,f14.6)") 'Most pmom iterations = ',pitsmax,' | max error = ',perrmax @@ -311,59 +201,16 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric naccreted = 0 nlive = 0 dtextforce_min = bignumber - !$omp parallel default(none) & - !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,fext,iphase,ntypes,massoftype,hdt,timei) & - !$omp shared(maxphase,maxp,apr_level,aprmassoftype) & - !$omp private(i,accreted) & - !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & - !$omp private(pri,pondensi,spsoundi,tempi,dtf) & - !$omp firstprivate(itype,pmassi) & - !$omp reduction(min:dtextforce_min) & - !$omp reduction(+:accretedmass,naccreted,nlive) & - !$omp shared(idamp,damp_fac) - !$omp do - accreteloop: do i=1,npart - if (.not.isdead_or_accreted(xyzh(4,i))) then - if (ntypes > 1 .and. maxphase==maxp) then - itype = iamtype(iphase(i)) - if (use_apr) then - pmassi = aprmassoftype(itype,apr_level(i)) - else - pmassi = massoftype(itype) - endif - ! if (itype==iboundary) cycle accreteloop - elseif (use_apr) then - pmassi = aprmassoftype(igas,apr_level(i)) - endif - - call equationofstate(ieos,pondensi,spsoundi,dens(i),xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi,vxyzu(4,i)) - pri = pondensi*dens(i) - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pri,fext(1:3,i),dtf) - dtextforce_min = min(dtextforce_min,C_force*dtf) - - if (idamp > 0) then - call apply_damp(fext(1,i), fext(2,i), fext(3,i), vxyzu(1:3,i), xyzh(1:3,i), damp_fac) - endif - - ! - ! correct v to the full step using only the external force - ! - pxyzu(1:3,i) = pxyzu(1:3,i) + hdt*fext(1:3,i) - ! Do we need call cons2prim here ?? - - if (iexternalforce > 0) then - call accrete_particles(iexternalforce,xyzh(1,i),xyzh(2,i), & - xyzh(3,i),xyzh(4,i),pmassi,timei,accreted,i) - if (accreted) then - accretedmass = accretedmass + pmassi - naccreted = naccreted + 1 - endif - endif - nlive = nlive + 1 - endif - enddo accreteloop - !$omp enddo - !$omp end parallel + + if (present(use_sink)) then + call accrete_gr_sink(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& + pxyzu,accretedmass,hdt,npart, & + ntypes,dtextforce_min,timei) + else + call accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& + pxyzu,accretedmass,hdt,npart, & + ntypes,dtextforce_min,timei) + endif if (npart > 2 .and. nlive < 2) then call fatal('step','all particles accreted',var='nlive',ival=nlive) @@ -849,7 +696,7 @@ subroutine get_force(nptmass,npart,nsubsteps,ntypes,timei,dtextforce,xyzh,vxyzu, force_count,extf_vdep_flag,linklist_ptmass,bin_info,group_info,& fsink_old,isionised) use io, only:iverbose,master,id,iprint,warning,fatal - use dim, only:maxp,maxvxyzu,itau_alloc,use_apr + use dim, only:maxp,maxvxyzu,itau_alloc,gr,use_apr use ptmass, only:get_accel_sink_gas,get_accel_sink_sink,merge_sinks, & ptmass_vdependent_correction,n_force_order use options, only:iexternalforce @@ -1219,8 +1066,552 @@ subroutine get_external_force_gas(xi,yi,zi,hi,vxi,vyi,vzi,timei,i,dtextforcenew, fextz = fextz + fextv(3) endif - end subroutine get_external_force_gas + !---------------------------------------------------------------- + !+ + ! routine for prediction substep in GR case + !+ + !---------------------------------------------------------------- +subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & + dens,metrics,metricderivs,pitsmax,perrmax, & + xitsmax,xerrmax,dtextforcenew) + + use dim, only:maxptmass,maxp,maxvxyzu,use_apr + use io, only:master,warning,fatal + use externalforces, only:externalforce,accrete_particles,update_externalforce + use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& + massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& + aprmassoftype,apr_level + use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete + use timestep, only:bignumber,xtol,ptol + use eos, only:equationofstate,ieos + use cons2primsolver,only:conservative2primitive + use extern_gr, only:get_grforce + use metric_tools, only:pack_metric,pack_metricderivs + use damping, only:calc_damp,apply_damp + + real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) + real, intent(in) :: dt,hdt,dtextforcenew,timei + integer, intent(in) :: npart,ntypes + integer, intent(inout) :: pitsmax,xitsmax + real, intent(inout) :: perrmax,xerrmax + + integer :: i,its,ierr,itype + integer, parameter :: itsmax = 50 + real :: pmassi + real :: pri,spsoundi,tempi,gammai + real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) + !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) + real :: x_err,pmom_err + ! real, save :: dmdt = 0. + logical :: converged + real :: rhoi,hi,eni,uui,densi + + !--------------------------- + ! predictor during substeps + !--------------------------- + ! + ! predictor step for external forces, also recompute external forces + ! + !$omp parallel do default(none) & + !$omp shared(npart,xyzh,vxyzu,fext,iphase,ntypes,massoftype) & + !$omp shared(maxphase,maxp,eos_vars) & + !$omp shared(dt,hdt,xtol,ptol,aprmassoftype,apr_level) & + !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & + !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi) & + !$omp private(converged,pmom_err,x_err,pri,ierr,gammai) & + !$omp firstprivate(pmassi,itype) & + !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & + !$omp reduction(min:dtextforcenew) + predictor: do i=1,npart + xyz(1) = xyzh(1,i) + xyz(2) = xyzh(2,i) + xyz(3) = xyzh(3,i) + hi = xyzh(4,i) + if (.not.isdead_or_accreted(hi)) then + if (ntypes > 1 .and. maxphase==maxp) then + itype = iamtype(iphase(i)) + if (use_apr) then + pmassi = aprmassoftype(itype,apr_level(i)) + else + pmassi = massoftype(itype) + endif + elseif (use_apr) then + pmassi = aprmassoftype(igas,apr_level(i)) + endif + + its = 0 + converged = .false. + ! + ! make local copies of array quantities + ! + pxyz(1:3) = pxyzu(1:3,i) + eni = pxyzu(4,i) + vxyz(1:3) = vxyzu(1:3,i) + uui = vxyzu(4,i) + fexti = fext(:,i) + + pxyz = pxyz + hdt*fexti + + !-- unpack thermo variables for the first guess in cons2prim + densi = dens(i) + pri = eos_vars(igasP,i) + gammai = eos_vars(igamma,i) + tempi = eos_vars(itemp,i) + rhoi = rhoh(hi,massoftype(igas)) + + ! Note: grforce needs derivatives of the metric, + ! which do not change between pmom iterations + pmom_iterations: do while (its <= itsmax .and. .not. converged) + its = its + 1 + pprev = pxyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& + tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + pxyz = pprev + hdt*(fstar - fexti) + pmom_err = maxval(abs(pxyz - pprev)) + if (pmom_err < ptol) converged = .true. + fexti = fstar + enddo pmom_iterations + if (its > itsmax ) call warning('substep_gr',& + 'max # of pmom iterations',var='pmom_err',val=pmom_err) + pitsmax = max(its,pitsmax) + perrmax = max(pmom_err,perrmax) + + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& + gammai,rhoi,pxyz,eni,ierr,ien_type) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) + xyz = xyz + dt*vxyz + call pack_metric(xyz,metrics(:,:,:,i)) + + its = 0 + converged = .false. + vxyz_star = vxyz + ! Note: since particle positions change between iterations + ! the metric and its derivatives need to be updated. + ! cons2prim does not require derivatives of the metric, + ! so those can updated once the iterations are complete + ! in order to reduce the number of computations. + xyz_iterations: do while (its <= itsmax .and. .not. converged) + its = its+1 + xyz_prev = xyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& + pri,tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) + xyz = xyz_prev + hdt*(vxyz_star - vxyz) + x_err = maxval(abs(xyz-xyz_prev)) + if (x_err < xtol) converged = .true. + vxyz = vxyz_star + ! UPDATE METRIC HERE + call pack_metric(xyz,metrics(:,:,:,i)) + enddo xyz_iterations + call pack_metricderivs(xyz,metricderivs(:,:,:,i)) + if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) + xitsmax = max(its,xitsmax) + xerrmax = max(x_err,xerrmax) + + ! re-pack arrays back where they belong + xyzh(1:3,i) = xyz(1:3) + pxyzu(1:3,i) = pxyz(1:3) + vxyzu(1:3,i) = vxyz(1:3) + vxyzu(4,i) = uui + fext(:,i) = fexti + dens(i) = densi + eos_vars(igasP,i) = pri + eos_vars(itemp,i) = tempi + eos_vars(igamma,i) = gammai + + ! Skip remainder of update if boundary particle; note that fext==0 for these particles + if (iamboundary(itype)) cycle predictor + endif +enddo predictor +!$omp end parallel do + + end subroutine predict_gr + + !---------------------------------------------------------------- + !+ + ! routine for prediction substep in GR case + !+ + !---------------------------------------------------------------- +subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & + dens,metrics,metricderivs,pitsmax,perrmax, & + xitsmax,xerrmax,dtextforcenew ) + + use dim, only:maxptmass,maxp,maxvxyzu + use io, only:master,warning,fatal + use externalforces, only:externalforce,accrete_particles,update_externalforce + use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& + massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,epot_sinksink,& + dsdt_ptmass + use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete + use timestep, only:bignumber,xtol,ptol + use eos, only:equationofstate,ieos + use cons2primsolver,only:conservative2primitive + use extern_gr, only:get_grforce + use metric_tools, only:pack_metric,pack_metricderivs + use damping, only:calc_damp,apply_damp + use ptmass, only:get_accel_sink_sink + use options, only:iexternalforce + + real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:),dtextforcenew + real, intent(in) :: dt,hdt,timei + integer, intent(in) :: npart,ntypes + integer, intent(inout) :: pitsmax,xitsmax + real, intent(inout) :: perrmax,xerrmax + + integer :: i,its,ierr,itype + integer, parameter :: itsmax = 50 + real :: pmassi + real :: pri,spsoundi,tempi,gammai + real :: fstar_sinks(4,npart) + real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) + !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) + real :: x_err,pmom_err + ! real, save :: dmdt = 0. + logical :: converged + real :: rhoi,hi,eni,uui,densi + integer :: merge_ij(2),merge_n + real :: dtsinksink + + call get_accel_sink_sink(npart,xyzh,fstar_sinks,epot_sinksink,dtsinksink,& + iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) + !--------------------------- + ! predictor during substeps + !--------------------------- + ! + ! predictor step for external forces, also recompute external forces + ! + !$omp parallel do default(none) & + !$omp shared(npart,xyzh,vxyzu,fext,iphase,ntypes,massoftype) & + !$omp shared(maxphase,maxp,eos_vars) & + !$omp shared(dt,hdt,xtol,ptol) & + !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & + !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce,fstar_sinks) & + !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi) & + !$omp private(converged,pmom_err,x_err,pri,ierr,gammai) & + !$omp firstprivate(pmassi,itype) & + !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & + !$omp reduction(min:dtextforcenew) + + predictor: do i=1,npart + xyz(1) = xyzh(1,i) + xyz(2) = xyzh(2,i) + xyz(3) = xyzh(3,i) + hi = xyzh(4,i) + if (.not.isdead_or_accreted(hi)) then + if (ntypes > 1 .and. maxphase==maxp) then + itype = iamtype(iphase(i)) + pmassi = massoftype(itype) + endif + + its = 0 + converged = .false. + ! + ! make local copies of array quantities + ! + pxyz(1:3) = pxyzu(1:3,i) + eni = 0. + vxyz(1:3) = vxyzu(1:3,i) + uui = 0. + fexti = fext(:,i) + pxyz = pxyz + hdt*fexti + + !-- unpack thermo variables for the first guess in cons2prim + densi = dens(i) + pri = 0. + gammai = 0. + tempi = 0. + rhoi = 1. + ! Note: grforce needs derivatives of the metric, + ! which do not change between pmom iterations + pmom_iterations: do while (its <= itsmax .and. .not. converged) + its = its + 1 + pprev = pxyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& + tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + + if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) + + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + call combine_forces_gr_one(fstar_sinks(1:3,i),fstar(1:3)) + ! fstar = fstar_sinks(1:3,i) + + pxyz = pprev + hdt*(fstar - fexti) + pmom_err = maxval(abs(pxyz - pprev)) + if (pmom_err < ptol) converged = .true. + fexti = fstar + enddo pmom_iterations + if (its > itsmax ) call warning('substep_gr',& + 'max # of pmom iterations',var='pmom_err',val=pmom_err) + pitsmax = max(its,pitsmax) + perrmax = max(pmom_err,perrmax) + + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& + gammai,rhoi,pxyz,eni,ierr,ien_type) + + if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) + xyz = xyz + dt*vxyz + call pack_metric(xyz,metrics(:,:,:,i)) + + its = 0 + converged = .false. + vxyz_star = vxyz + ! Note: since particle positions change between iterations + ! the metric and its derivatives need to be updated. + ! cons2prim does not require derivatives of the metric, + ! so those can updated once the iterations are complete + ! in order to reduce the number of computations. + xyz_iterations: do while (its <= itsmax .and. .not. converged) + its = its+1 + xyz_prev = xyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& + pri,tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) + xyz = xyz_prev + hdt*(vxyz_star - vxyz) + x_err = maxval(abs(xyz-xyz_prev)) + if (x_err < xtol) converged = .true. + vxyz = vxyz_star + ! UPDATE METRIC HERE + call pack_metric(xyz,metrics(:,:,:,i)) + enddo xyz_iterations + call pack_metricderivs(xyz,metricderivs(:,:,:,i)) + if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) + xitsmax = max(its,xitsmax) + xerrmax = max(x_err,xerrmax) + + ! re-pack arrays back where they belong + xyzh(1:3,i) = xyz(1:3) + pxyzu(1:3,i) = pxyz(1:3) + vxyzu(1:3,i) = vxyz(1:3) + fext(:,i) = fexti + dens(i) = densi + + ! Skip remainder of update if boundary particle; note that fext==0 for these particles + if (iamboundary(itype)) cycle predictor + endif +enddo predictor +!$omp end parallel do + + end subroutine predict_gr_sink + + !---------------------------------------------------------------- + !+ + ! routine for accretion step in GR case + !+ + !---------------------------------------------------------------- + subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& + pxyzu,accretedmass,hdt,npart,ntypes,dtextforce_min,timei) + + use dim, only:maxptmass,maxp,maxvxyzu,use_apr + use io, only:master,warning,fatal + use externalforces, only:externalforce,accrete_particles,update_externalforce + use options, only:iexternalforce + use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& + massoftype,rhoh,igamma,itemp,igasP,aprmassoftype,apr_level + use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete + use timestep, only:bignumber,C_force + use eos, only:equationofstate,ieos + use cons2primsolver,only:conservative2primitive + use extern_gr, only:get_grforce + use metric_tools, only:pack_metric,pack_metricderivs + use damping, only:calc_damp,apply_damp,idamp + + real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) + integer, intent(in) :: npart,ntypes + integer, intent(inout) :: nlive,naccreted + real, intent(inout) :: accretedmass + real, intent(in) :: hdt,timei + real, intent(out) :: dtextforce_min + + logical :: accreted + integer :: i,itype + real :: pmassi + real :: dtf + real :: pri,spsoundi,pondensi,tempi + real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) + !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) + real :: damp_fac + ! real, save :: dmdt = 0. + integer, parameter :: itsmax = 50 + + !$omp parallel default(none) & + !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,fext,iphase,ntypes,massoftype,hdt,timei) & + !$omp shared(maxphase,maxp,aprmassoftype,apr_level) & + !$omp private(i,accreted) & + !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & + !$omp private(pri,pondensi,spsoundi,tempi,dtf) & + !$omp firstprivate(itype,pmassi) & + !$omp reduction(min:dtextforce_min) & + !$omp reduction(+:accretedmass,naccreted,nlive) & + !$omp shared(idamp,damp_fac) + !$omp do + accreteloop: do i=1,npart + if (.not.isdead_or_accreted(xyzh(4,i))) then + if (ntypes > 1 .and. maxphase==maxp) then + itype = iamtype(iphase(i)) + if (use_apr) then + pmassi = aprmassoftype(itype,apr_level(i)) + else + pmassi = massoftype(itype) + endif + ! if (itype==iboundary) cycle accreteloop + elseif (use_apr) then + pmassi = aprmassoftype(igas,apr_level(i)) + endif + + call equationofstate(ieos,pondensi,spsoundi,dens(i),xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi,vxyzu(4,i)) + pri = pondensi*dens(i) + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pri,fext(1:3,i),dtf) + dtextforce_min = min(dtextforce_min,C_force*dtf) + + if (idamp > 0) then + call apply_damp(fext(1,i), fext(2,i), fext(3,i), vxyzu(1:3,i), xyzh(1:3,i), damp_fac) + endif + + ! + ! correct v to the full step using only the external force + ! + pxyzu(1:3,i) = pxyzu(1:3,i) + hdt*fext(1:3,i) + ! Do we need call cons2prim here ?? + + if (iexternalforce > 0) then + call accrete_particles(iexternalforce,xyzh(1,i),xyzh(2,i), & + xyzh(3,i),xyzh(4,i),pmassi,timei,accreted,i) + if (accreted) then + accretedmass = accretedmass + pmassi + naccreted = naccreted + 1 + endif + endif + nlive = nlive + 1 + endif + enddo accreteloop + !$omp enddo + !$omp end parallel + + end subroutine accrete_gr + + !---------------------------------------------------------------- + !+ + ! routine for accretion step in GR case + !+ + !---------------------------------------------------------------- + subroutine accrete_gr_sink(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& + pxyzu,accretedmass,hdt,npart,ntypes,dtextforce_min,timei) + + use dim, only:maxptmass,maxp,maxvxyzu + use io, only:master,warning,fatal + use externalforces, only:externalforce,accrete_particles,update_externalforce + use options, only:iexternalforce + use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& + massoftype,rhoh,igamma,itemp,igasP,epot_sinksink,dsdt_ptmass + use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete + use timestep, only:bignumber,C_force + use eos, only:equationofstate,ieos + use cons2primsolver,only:conservative2primitive + use extern_gr, only:get_grforce + use metric_tools, only:pack_metric,pack_metricderivs + use damping, only:calc_damp,apply_damp,idamp + use ptmass, only:get_accel_sink_sink + real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) + integer, intent(in) :: npart,ntypes + integer, intent(inout) :: nlive,naccreted + real, intent(inout) :: accretedmass + real, intent(in) :: hdt,timei + real, intent(out) :: dtextforce_min + + logical :: accreted + integer :: i,itype + real :: pmassi + real :: dtf + real :: pri,spsoundi,pondensi,tempi + real :: fstar_sinks(4,npart) + real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) + integer :: merge_ij(2),merge_n + real :: dtsinksink + integer :: iexternalforce_n + !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) + real :: damp_fac + ! real, save :: dmdt = 0. + integer, parameter :: itsmax = 50 + + call get_accel_sink_sink(npart,xyzh,fstar_sinks,epot_sinksink,dtsinksink,& + iexternalforce_n,timei,merge_ij,merge_n,dsdt_ptmass) + !$omp parallel default(none) & + !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,fext,iphase,ntypes,massoftype,hdt,timei) & + !$omp shared(maxphase,maxp) & + !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,fstar_sinks) & + !$omp private(i,accreted) & + !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & + !$omp private(pri,pondensi,spsoundi,tempi,dtf) & + !$omp firstprivate(itype,pmassi) & + !$omp reduction(min:dtextforce_min) & + !$omp reduction(+:accretedmass,naccreted,nlive) & + !$omp shared(idamp,damp_fac) + !$omp do + + accreteloop: do i=1,npart + pmassi = xyzh(4,i) + pri = 0. + + ! add this force due to the curvature of the metric. + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),0.,pri,fext(1:3,i),dtf) + call combine_forces_gr_one(fstar_sinks(1:3,i),fext(1:3,i)) + + if (all(abs(fstar_sinks(1:3,i) - fext(1:3,i)) < epsilon(0.))) then + dtextforce_min = C_force*dtsinksink + else + dtextforce_min = min(dtextforce_min,C_force*dtf,C_force*dtsinksink) + endif + + if (idamp > 0) then + call apply_damp(fext(1,i), fext(2,i), fext(3,i), vxyzu(1:3,i), xyzh(1:3,i), damp_fac) + endif + + ! + ! correct v to the full step using only the external force + ! + pxyzu(1:3,i) = pxyzu(1:3,i) + hdt*fext(1:3,i) + ! Do we need call cons2prim here ?? + + if (iexternalforce > 0) then + call accrete_particles(iexternalforce,xyzh(1,i),xyzh(2,i), & + xyzh(3,i),xyzh(5,i),pmassi,timei,accreted,i) + if (accreted) then + accretedmass = accretedmass + pmassi + naccreted = naccreted + 1 + endif + endif + nlive = nlive + 1 + + enddo accreteloop + !$omp enddo + !$omp end parallel + + end subroutine accrete_gr_sink + + subroutine combine_forces_gr(nptmass,fsinks,fgr) + real, intent(in) :: fsinks(:,:) + integer, intent(in) :: nptmass + + real, intent(inout) :: fgr(:,:) + + integer :: i + + do i=1,nptmass + fgr(:,i) = fsinks(:,i) + fgr(:,i) + enddo + end subroutine combine_forces_gr + + + subroutine combine_forces_gr_one(fsink,fgr) + real, intent(in) :: fsink(:) + real, intent(inout) :: fgr(:) + + fgr(:) = fgr(:) + fsink(:) + + end subroutine combine_forces_gr_one end module substepping From a5b144bff40e0c1ba358b477db0f3f81bcfeeae4 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:34:45 +1100 Subject: [PATCH 15/54] (binary stars around BH) we can set binary stars around a BH now --- src/setup/setup_grtde.f90 | 401 +++++++++++++++++++++++++++----------- 1 file changed, 282 insertions(+), 119 deletions(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 65df28533..655ce0eb5 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -15,25 +15,32 @@ module setup ! :Runtime parameters: ! - beta : *penetration factor* ! - dumpsperorbit : *number of dumps per orbit* -! - ecc : *eccentricity (1 for parabolic)* +! - ecc_bh : *eccentricity (1 for parabolic)* ! - mhole : *mass of black hole (solar mass)* ! - norbits : *number of orbits* ! - relax : *relax star into hydrostatic equilibrium* -! - theta : *inclination of orbit (degrees)* +! - theta_bh : *inclination of orbit (degrees)* ! ! :Dependencies: eos, externalforces, gravwaveutils, infile_utils, io, ! kernel, metric, mpidomain, options, part, physcon, relaxstar, ! setbinary, setstar, setup_params, systemutils, timestep, units, ! vectorutils ! - use setstar, only:star_t + + use setstar, only:star_t + use setorbit, only:orbit_t implicit none public :: setpart - real :: mhole,beta,ecc,norbits,theta - integer :: dumpsperorbit + real :: mhole,beta,ecc_bh,norbits,theta_bh + real :: a_binary + real :: x1,y1,z1,x2,y2,z2 + real :: vx1,vy1,vz1,vx2,vy2,vz2 + integer :: dumpsperorbit,nstar logical :: relax - type(star_t) :: star + logical :: provide_params + type(star_t) :: star(2) + type(orbit_t) :: orbit private @@ -46,10 +53,11 @@ module setup !---------------------------------------------------------------- subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact,time,fileprefix) use part, only:nptmass,xyzmh_ptmass,vxyz_ptmass,ihacc,ihsoft,igas,& - gravity,eos_vars,rad,gr + gravity,eos_vars,rad,gr,nsinkproperties use setbinary, only:set_binary - use setstar, only:set_star,shift_star - use units, only:set_units,umass,udist + use setorbit, only:set_defaults_orbit,set_orbit + use setstar, only:set_star,shift_star,set_defaults_stars,set_defaults_star,set_stars,shift_stars + use units, only:set_units,umass,udist,unit_velocity use physcon, only:solarm,pi,solarr use io, only:master,fatal,warning use timestep, only:tmax,dtmax @@ -62,7 +70,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, use gravwaveutils, only:theta_gw,calc_gravitwaves use setup_params, only:rhozero,npart_total use systemutils, only:get_command_option - use options, only:iexternalforce + use options, only:iexternalforce,damp integer, intent(in) :: id integer, intent(inout) :: npart integer, intent(out) :: npartoftype(:) @@ -73,12 +81,18 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, character(len=20), intent(in) :: fileprefix real, intent(out) :: vxyzu(:,:) character(len=120) :: filename + character(len=20) :: semi_major_axis + character(len=20) :: semi_major_axis_str integer :: ierr,np_default + integer :: nptmass_in,iextern_prev + integer :: i,ios logical :: iexist,write_profile,use_var_comp real :: rtidal,rp,semia,period,hacc1,hacc2 real :: vxyzstar(3),xyzstar(3) real :: r0,vel,lorentz real :: vhat(3),x0,y0 + real :: semi_maj_val + real :: xyzmh_ptmass_in(nsinkproperties,2),vxyz_ptmass_in(3,2),angle ! !-- general parameters ! @@ -100,27 +114,38 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, !-- Default runtime parameters ! mhole = 1.e6 ! (solar masses) - call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set central mass to M=1 in code units - star%mstar = 1.*solarm/umass - star%rstar = 1.*solarr/udist +if (gr) then + call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set umass as 1e6*msun + else + call set_units(mass=solarm,dist=solarr,G=1.d0) + endif +! star%mstar = 1.*solarm/umass +! star%rstar = 1.*solarr/udist np_default = 1e6 - star%np = int(get_command_option('np',default=np_default)) ! can set default value with --np=1e5 flag (mainly for testsuite) - star%iprofile = 2 +! star%np = int(get_command_option('np',default=np_default)) ! can set default value with --np=1e5 flag (mainly for testsuite) +! star%iprofile = 2 beta = 5. - ecc = 0.8 + ecc_bh = 0.8 norbits = 5. dumpsperorbit = 100 - theta = 0. + theta_bh = 0. write_profile = .false. use_var_comp = .false. relax = .true. + + if (nstar > 1) then + call set_defaults_stars(star) + call set_defaults_orbit(orbit) + else + call set_defaults_star(star(1)) + endif ! !-- Read runtime parameters from setup file ! if (id==master) print "(/,65('-'),1(/,a),/,65('-'),/)",' Tidal disruption in GR' filename = trim(fileprefix)//'.setup' inquire(file=filename,exist=iexist) - if (iexist) call read_setupfile(filename,ieos,polyk,ierr) + if (iexist) call read_setupfile(filename,ieos,polyk,mass1,ierr) if (.not. iexist .or. ierr /= 0) then if (id==master) then call write_setupfile(filename) @@ -128,84 +153,123 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, endif stop endif - + ! + !--set nstar/nptmass stars around the BH. This would also relax the star. + ! + call set_stars(id,master,nstar,star,xyzh,vxyzu,eos_vars,rad,npart,npartoftype,& + massoftype,hfact,xyzmh_ptmass,vxyz_ptmass,nptmass,ieos,polyk,gamma,& + X_in,Z_in,relax,use_var_comp,write_profile,& + rhozero,npart_total,i_belong,ierr) + + if (star(1)%iprofile == 0 .and. nstar == 1) then + xyzmh_ptmass_in(4,1) = star(1)%mstar + xyzmh_ptmass_in(5,1) = star(1)%hacc + + endif + + ! + !--set the stars around each other first if nstar > 1 (Assuming binary system) ! - !--set up and relax a star + if (nstar > 1 .and. (.not. provide_params)) then + nptmass_in = 0 + call set_orbit(orbit,star(1)%mstar,star(2)%mstar,star(1)%hacc,star(2)%hacc,& + xyzmh_ptmass_in,vxyz_ptmass_in,nptmass_in,(id==master),ierr) + + if (ierr /= 0) call fatal ('setup_binary','error in call to set_orbit') + if (ierr /= 0) call fatal('setup','errors in set_star') + endif + ! - call set_star(id,master,star,xyzh,vxyzu,eos_vars,rad,npart,npartoftype,& - massoftype,hfact,xyzmh_ptmass,vxyz_ptmass,nptmass,ieos,polyk,gamma,& - X_in,Z_in,relax,use_var_comp,write_profile,& - rhozero,npart_total,i_belong,ierr) - - if (ierr /= 0) call fatal('setup','errors in set_star') - + !--place star / stars into orbit ! - !--place star into orbit - ! - rtidal = star%rstar*(mass1/star%mstar)**(1./3.) - rp = rtidal/beta - accradius1_hard = 5.*mass1 - accradius1 = accradius1_hard + ! Calculate tidal radius + if (nstar == 1) then + ! for single star around the BH, the tidal radius is given by + ! RT = rr * (MM / mm)**(1/3) where rr is rstar, MM is mass of BH and mm is mass of star + rtidal = star(1)%rstar * (mass1/star(1)%mstar)**(1./3.) + rp = rtidal/beta + else + semi_major_axis_str = orbit%elems%semi_major_axis + read(semi_major_axis_str, *, iostat=ios) semi_maj_val + ! for a binary, tidal radius is given by + ! orbit.an * (3 * MM / mm)**(1/3) where mm is mass of binary and orbit.an is semi-major axis of binary + rtidal = semi_maj_val * (3.*mass1 / (star(1)%mstar + star(2)%mstar))**(1./3.) + rp = rtidal/beta + endif + + if (gr) then + accradius1_hard = 5.*mass1 + accradius1 = accradius1_hard + else + accradius1_hard = 6. + accradius1 = accradius1_hard + endif a = 0. - theta = theta*pi/180. - - print*, 'mstar', star%mstar - print*, 'rstar', star%rstar + theta_bh = theta_bh*pi/180. + print*, 'umass', umass print*, 'udist', udist + print*, 'uvel', unit_velocity print*, 'mass1', mass1 print*, 'tidal radius', rtidal print*, 'beta', beta - - xyzstar = 0. - vxyzstar = 0. - period = 0. - - if (ecc<1.) then - ! - !-- Set a binary orbit given the desired orbital parameters to get the position and velocity of the star - ! - semia = rp/(1.-ecc) - period = 2.*pi*sqrt(semia**3/mass1) - print*, 'period', period - hacc1 = star%rstar/1.e8 ! Something small so that set_binary doesnt warn about Roche lobe - hacc2 = hacc1 - ! apocentre = rp*(1.+ecc)/(1.-ecc) - ! trueanom = acos((rp*(1.+ecc)/r0 - 1.)/ecc)*180./pi - call set_binary(mass1,star%mstar,semia,ecc,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,& - posang_ascnode=0.,arg_peri=90.,incl=0.,f=-180.) - vxyzstar = vxyz_ptmass(1:3,2) - xyzstar = xyzmh_ptmass(1:3,2) - nptmass = 0 - - call rotatevec(xyzstar,(/0.,1.,0./),-theta) - call rotatevec(vxyzstar,(/0.,1.,0./),-theta) - - elseif (abs(ecc-1.) < tiny(0.)) then - ! - !-- Setup a parabolic orbit - ! - r0 = 10.*rtidal ! A default starting distance from the black hole. - period = 2.*pi*sqrt(r0**3/mass1) !period not defined for parabolic orbit, so just need some number - y0 = -2.*rp + r0 - x0 = sqrt(r0**2 - y0**2) - xyzstar = (/-x0,y0,0./) - vel = sqrt(2.*mass1/r0) - vhat = (/2.*rp,-x0,0./)/sqrt(4.*rp**2 + x0**2) - vxyzstar = vel*vhat - - call rotatevec(xyzstar,(/0.,1.,0./),theta) - call rotatevec(vxyzstar,(/0.,1.,0./),theta) - - else - call fatal('setup','please choose a valid eccentricity (01.1) call warning('setup','Lorentz factor of star greater than 1.1, density may not be correct') - - tmax = norbits*period - dtmax = period/dumpsperorbit + print*, accradius1_hard, "accradius1_hard",mass1,"mass1" + + if (.not. provide_params) then + do i = 1, nstar + print*, 'mstar of star ',i,' is: ', star(i)%mstar + print*, 'rstar of star ',i,' is: ', star(i)%rstar + enddo + + xyzstar = 0. + vxyzstar = 0. + period = 0. + + if (ecc_bh<1.) then + ! + !-- Set a binary orbit given the desired orbital parameters to get the position and velocity of the star + ! + semia = rp/(1.-ecc_bh) + period = 2.*pi*sqrt(semia**3/mass1) + hacc1 = star(1)%rstar/1.e8 ! Something small so that set_binary doesnt warn about Roche lobe + hacc2 = hacc1 + ! apocentre = rp*(1.+ecc_bh)/(1.-ecc_bh) + ! trueanom = acos((rp*(1.+ecc_bh)/r0 - 1.)/ecc_bh)*180./pi + call set_binary(mass1,star(1)%mstar,semia,ecc_bh,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,& + posang_ascnode=0.,arg_peri=90.,incl=0.,f=-180.) + vxyzstar(:) = vxyz_ptmass(1:3,2) + xyzstar(:) = xyzmh_ptmass(1:3,2) + nptmass = 0 + + call rotatevec(xyzstar,(/0.,1.,0./),-theta_bh) + call rotatevec(vxyzstar,(/0.,1.,0./),-theta_bh) + + elseif (abs(ecc_bh-1.) < tiny(0.)) then + ! + !-- Setup a parabolic orbit + ! + r0 = 10.*rtidal ! A default starting distance from the black hole. + period = 2.*pi*sqrt(r0**3/mass1) !period not defined for parabolic orbit, so just need some number + y0 = -2.*rp + r0 + x0 = sqrt(r0**2 - y0**2) + xyzstar(:) = (/-x0,y0,0./) + vel = sqrt(2.*mass1/r0) + vhat = (/2.*rp,-x0,0./)/sqrt(4.*rp**2 + x0**2) + vxyzstar(:) = vel*vhat + + call rotatevec(xyzstar,(/0.,1.,0./),theta_bh) + call rotatevec(vxyzstar,(/0.,1.,0./),theta_bh) + + else + call fatal('setup','please choose a valid eccentricity (01.1) call warning('setup','Lorentz factor of star greater than 1.1, density may not be correct') + + tmax = norbits*period + dtmax = period/dumpsperorbit + endif if (id==master) then print "(/,a)", ' STAR SETUP:' @@ -215,24 +279,44 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, print "(a,1f10.3)" ,' Polytropic gamma = ',gamma print "(a,3f10.3,/)",' Pericentre = ',rp endif + ! + !--shift stars / sink particles + ! + if (provide_params) then + xyzmh_ptmass_in(1:3,1) = (/x1,y1,z1/) + xyzmh_ptmass_in(1:3,2) = (/x2,y2,z2/) + vxyz_ptmass_in(:,1) = (/vx1, vy1, vz1/) + vxyz_ptmass_in(:,2) = (/vx2, vy2, vz2/) + + xyzmh_ptmass_in(4,1) = star(1)%mstar + xyzmh_ptmass_in(5,1) = star(1)%hacc + + xyzmh_ptmass_in(4,2) = star(2)%mstar + xyzmh_ptmass_in(5,2) = star(2)%hacc + else + xyzmh_ptmass_in(1:3,1) = xyzmh_ptmass_in(1:3,1) + xyzstar(:) + vxyz_ptmass_in(1:3,1) = vxyz_ptmass_in(1:3,1) + vxyzstar(:) + endif - call shift_star(npart,xyzh,vxyzu,x0=xyzstar,v0=vxyzstar) + call shift_stars(nstar,star,xyzmh_ptmass_in,vxyz_ptmass_in,& + xyzh,vxyzu,xyzmh_ptmass,vxyz_ptmass,npart,& + nptmass) if (id==master) print "(/,a,i10,/)",' Number of particles setup = ',npart ! - ! set a few options for the input file + !--set a few options for the input file ! calc_gravitwaves = .true. - if (abs(ecc-1.) > epsilon(0.)) then - theta_gw = theta*180./pi + if (abs(ecc_bh-1.) > epsilon(0.)) then + theta_gw = theta_bh*180./pi else - theta_gw = -theta*180./pi + theta_gw = -theta_bh*180./pi endif if (.not.gr) iexternalforce = 1 - - if (npart == 0) call fatal('setup','no particles setup') + ! We have ignored the following error message. + !if (npart == 0) call fatal('setup','no particles setup') if (ierr /= 0) call fatal('setup','ERROR during setup') end subroutine setpart @@ -242,40 +326,61 @@ end subroutine setpart ! subroutine write_setupfile(filename) use infile_utils, only:write_inopt - use setstar, only:write_options_star + use setstar, only:write_options_star,write_options_stars use relaxstar, only:write_options_relax + use setorbit, only:write_options_orbit character(len=*), intent(in) :: filename integer :: iunit print "(a)",' writing setup options file '//trim(filename) open(newunit=iunit,file=filename,status='replace',form='formatted') write(iunit,"(a)") '# input file for tidal disruption setup' - call write_options_star(star,iunit) - call write_inopt(relax,'relax','relax star into hydrostatic equilibrium',iunit) - if (relax) call write_options_relax(iunit) - - write(iunit,"(/,a)") '# options for black hole and orbit' - call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)',iunit) - call write_inopt(beta, 'beta', 'penetration factor', iunit) - call write_inopt(ecc, 'ecc', 'eccentricity (1 for parabolic)', iunit) - call write_inopt(norbits, 'norbits', 'number of orbits', iunit) - call write_inopt(dumpsperorbit,'dumpsperorbit','number of dumps per orbit', iunit) - call write_inopt(theta, 'theta', 'inclination of orbit (degrees)', iunit) + call write_inopt(provide_params,'provide_params','initial conditions',iunit) + call write_inopt(nstar, 'nstar', 'number of stars to set',iunit) + + if (nstar .ne. 0) then + if (nstar == 1) then + call write_options_star(star(1),iunit) + call write_inopt(relax,'relax','relax star into hydrostatic equilibrium',iunit) + if (relax) call write_options_relax(iunit) + else + call write_options_stars(star,relax,iunit) + endif + + + write(iunit,"(/,a)") '# options for black hole and orbit' + call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)',iunit) + if (.not. provide_params) then + call write_inopt(beta, 'beta', 'penetration factor', iunit) + call write_inopt(ecc_bh, 'ecc_bh', 'eccentricity (1 for parabolic)', iunit) + call write_inopt(norbits, 'norbits', 'number of orbits', iunit) + call write_inopt(dumpsperorbit,'dumpsperorbit','number of dumps per orbit', iunit) + call write_inopt(theta_bh, 'theta_bh', 'inclination of orbit (degrees)', iunit) + if (nstar > 1) then + call write_options_orbit(orbit,iunit) + endif + else + write(iunit,"(/,a)") '# provide inputs for the binary system' + call write_params(iunit) + endif + endif close(iunit) end subroutine write_setupfile -subroutine read_setupfile(filename,ieos,polyk,ierr) +subroutine read_setupfile(filename,ieos,polyk,mass1,ierr) use infile_utils, only:open_db_from_file,inopts,read_inopt,close_db use io, only:error - use setstar, only:read_options_star + use setstar, only:read_options_star,read_options_stars use relaxstar, only:read_options_relax use physcon, only:solarm,solarr - use units, only:set_units + use units, only:set_units,umass + use setorbit, only:read_options_orbit character(len=*), intent(in) :: filename integer, intent(inout) :: ieos real, intent(inout) :: polyk integer, intent(out) :: ierr + real, intent(out) :: mass1 integer, parameter :: iunit = 21 integer :: nerr,need_iso type(inopts), allocatable :: db(:) @@ -287,20 +392,39 @@ subroutine read_setupfile(filename,ieos,polyk,ierr) ! !--read black hole mass and use it to define code units ! + call read_inopt(provide_params,'provide_params',db,errcount=nerr) call read_inopt(mhole,'mhole',db,min=0.,errcount=nerr) - call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set central mass to M=1 in code units +! call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set central mass to M=1 in code units + ! This ensures that we can run simulations with BH's as massive as 1e9 msun. + ! A BH of mass 1e9 msun would be 1e3 in code units when umass is 1e6*solar masses. + mass1 = mhole*solarm/umass + call read_inopt(nstar, 'nstar', db,min=0,errcount=nerr) ! !--read star options and convert to code units ! - call read_options_star(star,need_iso,ieos,polyk,db,nerr) - call read_inopt(relax,'relax',db,errcount=nerr) - if (relax) call read_options_relax(db,nerr) - - call read_inopt(beta, 'beta', db,min=0.,errcount=nerr) - call read_inopt(ecc, 'ecc', db,min=0.,max=1.,errcount=nerr) - call read_inopt(norbits, 'norbits', db,min=0.,errcount=nerr) - call read_inopt(dumpsperorbit, 'dumpsperorbit', db,min=0 ,errcount=nerr) - call read_inopt(theta, 'theta', db, errcount=nerr) + if (nstar .ne. 0) then + if (nstar == 1) then + call read_options_star(star(1),need_iso,ieos,polyk,db,nerr) + call read_inopt(relax,'relax',db,errcount=nerr) + if (relax) call read_options_relax(db,nerr) + else + call read_options_stars(star,need_iso,ieos,polyk,relax,db,nerr) + endif + + if (.not. provide_params) then + call read_inopt(beta, 'beta', db,min=0.,errcount=nerr) + call read_inopt(ecc_bh, 'ecc_bh', db,min=0.,max=1.,errcount=nerr) + call read_inopt(norbits, 'norbits', db,min=0.,errcount=nerr) + call read_inopt(dumpsperorbit, 'dumpsperorbit', db,min=0 ,errcount=nerr) + call read_inopt(theta_bh, 'theta_bh', db, errcount=nerr) + if (nstar > 1) then + call read_options_orbit(orbit,db,nerr) + endif + else + call read_params(db,nerr) + endif + + endif call close_db(db) if (nerr > 0) then print "(1x,i2,a)",nerr,' error(s) during read of setup file: re-writing...' @@ -309,4 +433,43 @@ subroutine read_setupfile(filename,ieos,polyk,ierr) end subroutine read_setupfile +subroutine write_params(iunit) + use infile_utils, only:write_inopt + integer, intent(in) :: iunit + + call write_inopt(x1, 'x1', 'pos x star 1', iunit) + call write_inopt(y1, 'y1', 'pos y star 1', iunit) + call write_inopt(z1, 'z1', 'pos z star 1', iunit) + call write_inopt(x2, 'x2', 'pos x star 2', iunit) + call write_inopt(y2, 'y2', 'pos y star 2', iunit) + call write_inopt(z2, 'z2', 'pos z star 2', iunit) + call write_inopt(vx1, 'vx1', 'vel x star 1', iunit) + call write_inopt(vy1, 'vy1', 'vel y star 1', iunit) + call write_inopt(vz1, 'vz1', 'vel z star 1', iunit) + call write_inopt(vx2, 'vx2', 'vel x star 2', iunit) + call write_inopt(vy2, 'vy2', 'vel y star 2', iunit) + call write_inopt(vz2, 'vz2', 'vel z star 2', iunit) + +end subroutine write_params + +subroutine read_params(db,nerr) + use infile_utils, only:inopts,read_inopt + type(inopts), allocatable, intent(inout) :: db(:) + integer, intent(inout) :: nerr + + call read_inopt(x1, 'x1', db,errcount=nerr) + call read_inopt(y1, 'y1', db,errcount=nerr) + call read_inopt(z1, 'z1', db,errcount=nerr) + call read_inopt(x2, 'x2', db,errcount=nerr) + call read_inopt(y2, 'y2', db,errcount=nerr) + call read_inopt(z2, 'z2', db,errcount=nerr) + call read_inopt(vx1, 'vx1', db,errcount=nerr) + call read_inopt(vy1, 'vy1', db,errcount=nerr) + call read_inopt(vz1, 'vz1', db,errcount=nerr) + call read_inopt(vx2, 'vx2', db,errcount=nerr) + call read_inopt(vy2, 'vy2', db,errcount=nerr) + call read_inopt(vz2, 'vz2', db,errcount=nerr) + +end subroutine read_params + end module setup From 694e42d4b8cd2b8588354a14d164fcc8e91a065c Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:35:30 +1100 Subject: [PATCH 16/54] (gr_sink) prim2consall has dens as an optional argument --- src/tests/test_gr.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/tests/test_gr.f90 b/src/tests/test_gr.f90 index bdc1ad0fa..71c38f225 100644 --- a/src/tests/test_gr.f90 +++ b/src/tests/test_gr.f90 @@ -208,7 +208,7 @@ subroutine integrate_geodesic(tmax,dt,xyz,vxyz,angmom0,angmom) ien_type = 1 call init_metric(npart,xyzh,metrics,metricderivs) - call prim2consall(npart,xyzh,metrics,vxyzu,dens,pxyzu,use_dens=.false.) + call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtextforce) call calculate_angmom(xyzh(1:3,1),metrics(:,:,:,1),massi,vxyzu(1:3,1),angmom0) From 87075c849b12bef3e354da1d7b5575a8aa7d7db3 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:36:48 +1100 Subject: [PATCH 17/54] (gr_sink) test subroutine for gr sinks --- src/tests/test_ptmass.f90 | 182 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 176 insertions(+), 6 deletions(-) diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index da7f7dac6..71d9ab2c6 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -41,6 +41,7 @@ subroutine test_ptmass(ntests,npass,string) integer :: itmp,ierr,itest,istart logical :: do_test_binary,do_test_accretion,do_test_createsink,do_test_softening logical :: do_test_chinese_coin,do_test_merger,do_test_potential,do_test_HII,do_test_SDAR + logical :: do_test_binary_gr logical :: testall if (id==master) write(*,"(/,a,/)") '--> TESTING PTMASS MODULE' @@ -54,11 +55,14 @@ subroutine test_ptmass(ntests,npass,string) do_test_chinese_coin = .false. do_test_HII = .false. do_test_SDAR = .false. + do_test_binary_gr = .false. testall = .false. istart = 1 select case(trim(string)) case('ptmassbinary') do_test_binary = .true. + case('ptmassgenrel') + do_test_binary_gr = .true. case('ptmassaccrete') do_test_accretion = .true. case('ptmasscreatesink') @@ -119,8 +123,13 @@ subroutine test_ptmass(ntests,npass,string) ! Test sink particle mergers ! if (do_test_merger .or. testall) call test_merger(ntests,npass) + enddo ! + ! Test for sink particles in GR + ! + if (do_test_binary_gr .or. testall) call test_sink_binary_gr(ntests,npass,string) + ! ! Test of sink particle potentials ! if (do_test_potential .or. testall) call test_sink_potential(ntests,npass) @@ -308,7 +317,7 @@ subroutine test_binary(ntests,npass,string) ! if (id==master) then call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink) + dtsinksink,0,merge_ij,merge_n,dsdt_sinksink,ti=0.) endif fxyz_ptmass(:,1:nptmass) = 0. dsdt_ptmass(:,1:nptmass) = 0. @@ -448,6 +457,167 @@ subroutine test_binary(ntests,npass,string) end subroutine test_binary +!----------------------------------------------------------------------- +!+ +! Test that binary setup in GR using sink particles is OK. +!+ +!----------------------------------------------------------------------- +subroutine test_sink_binary_gr(ntests,npass,string) + use io, only:id,master,iverbose + use part, only:init_part,npart,npartoftype,nptmass,xyzmh_ptmass,vxyz_ptmass,& + epot_sinksink,metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& + dens_ptmass,fxyz_ptmass + use timestep, only:C_force,dtextforce,dtmax + use physcon, only:solarm,pi + use units, only:set_units + use setbinary, only:set_binary + use metric, only:mass1 + use checksetup, only:check_setup + use testutils, only:checkval,checkvalf,update_test_scores + use ptmass, only:get_accel_sink_sink + use metric_tools, only:init_metric + use cons2prim, only:prim2consall + use extern_gr, only:get_grforce_all + use substepping, only:combine_forces_gr + use energies, only:angtot,etot,totmom,compute_energies,epot + use step_lf_global, only:init_step + use substepping, only:substep_gr + integer, intent(inout) :: ntests,npass + character(len=*), intent(in) :: string + real :: fxyz_sinksink(4,2),dsdt_sinksink(3,2) ! we only use 2 sink particles in the tests here + real :: m1,m2,a,ecc,hacc1,hacc2,t,dt,tol_en + real :: dtsinksink,tol,omega,errmax,dis + real :: angmomin,etotin,totmomin,dtsph + integer :: ierr,nerr,nfailed(6),nwarn,nsteps,i + integer :: merge_ij(2),merge_n,norbits + character(len=20) :: dumpfile + ! + !--no gas particles + ! + call init_part() + ! + !--set quantities + ! + npartoftype = 0 + npart = 0 + nptmass = 0 + m1 = 1.e-6 + m2 = 1.e-6 + a = 2.35 ! udist in GR is 1.48E+11. 5 Rsun in code units + ecc = 0. ! eccentricity of binary orbit + hacc1 = 0.75 ! 0.35 rsun in code units + hacc2 = 0.75 + mass1 = 0. ! set BH mass as 0. So the metric becomes Minkowski + t = 0. + ! chose a very small value because a value of 0.35 was resulting in distance - distance_init of 1.e-3 + ! but using a small timestep resulted in values smaller than equal to 1.e-4 + C_force = 0.01 + norbits = 2 + tol = epsilon(0.) + omega = sqrt((m1+m2)/a**3) + ! set sinks around each other + call set_units(mass=1.e6*solarm,c=1.d0,G=1.d0) + call set_binary(m1,m2,a,ecc,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,verbose=.false.) + dis = norm2(xyzmh_ptmass(1:3,1) - xyzmh_ptmass(1:3,2)) + + if (ierr /= 0) nerr = nerr + 1 + + ! check the setup is ok + nfailed = 0 + call check_setup(nerr,nwarn) + call checkval(nerr,0,0,nfailed(1),'no errors during setting sink binary orbit') + call update_test_scores(ntests,nfailed,npass) + ! + !--initialise forces and test that the curvature contribution is 0. when mass1 is 0. + ! + if (id==master) then + + call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) + call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& + vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,dens=dens_ptmass,use_sink=.true.) + ! sinks in GR, provide external force due to metric to determine the sink total force + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& + dtsinksink,0,merge_ij,merge_n,dsdt_sinksink,ti=0.) + call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& + vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) + call combine_forces_gr(nptmass,fxyz_sinksink,fxyz_ptmass) + + ! Test the force calculated is same as sink-sink because there is no curvature. + + call checkval(fxyz_sinksink(1,1), fxyz_ptmass(1,1),tol,nfailed(1),'x force term for sink 1') + call checkval(fxyz_sinksink(1,2), fxyz_ptmass(1,2),tol,nfailed(2),'y force term for sink 1') + call checkval(fxyz_sinksink(1,3), fxyz_ptmass(1,3),tol,nfailed(3),'z force term for sink 1') + call checkval(fxyz_sinksink(2,1), fxyz_ptmass(2,1),tol,nfailed(4),'x force term for sink 2') + call checkval(fxyz_sinksink(2,2), fxyz_ptmass(2,2),tol,nfailed(5),'y force term for sink 2') + call checkval(fxyz_sinksink(2,3), fxyz_ptmass(2,3),tol,nfailed(6),'z force term for sink 2') + + call update_test_scores(ntests,nfailed(1:3),npass) + call update_test_scores(ntests,nfailed(3:6),npass) + + endif + ! + !--check energy and angular momentum of the system + ! + dtextforce = C_force*dtsinksink + dtmax = max(dtextforce, dtsinksink) + dt = dtextforce + call compute_energies(t) + etotin = etot + totmomin = totmom + angmomin = angtot + + call checkval(epot,-m1*m2/a,epsilon(0.),nfailed(1),'potential energy') + call update_test_scores(ntests,nfailed,npass) + ! + !--check initial angular momentum on the two sinks is correct + ! + call checkval(angtot,m1*m2*sqrt(a/(m1 + m2)),1e6*epsilon(0.),nfailed(2),'angular momentum') + call update_test_scores(ntests,nfailed,npass) + ! + !--check initial total energy of the two sinks is correct + !--using Virial Theorem for the test + ! + call checkval(etot,epot*0.5,epsilon(0.),nfailed(3),'total energy') + call update_test_scores(ntests,nfailed,npass) + ! + !--determine number of steps per orbit for information + ! + nsteps = int(2.*pi/omega/dt) + 1 + nsteps = nsteps*norbits + errmax = 0. + dumpfile='test_00000' + + call init_step(nptmass,t,dtmax) + + do i=1,nsteps + dtsph = dt + + call substep_gr(nptmass,nptmass,dtsph,dtextforce,xyzmh_ptmass,vxyz_ptmass,& + pxyzu_ptmass,dens_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass,time=t,use_sink=.true.) + + call compute_energies(t) + errmax = max(errmax,abs(etot - etotin)) + t = t + dt + dis = norm2(xyzmh_ptmass(1:3,1) - xyzmh_ptmass(1:3,2)) + enddo + ! + !--check the radius of the orbit does not change + ! + call checkval(dis,a,1.e-4,nfailed(1),"radius of orbit") + call update_test_scores(ntests,nfailed,npass) + ! + !--check energy, linear and angular momentum conservation + ! + tol_en = 1.e-10 + call compute_energies(t) + call checkval(angtot,angmomin,tol_en,nfailed(1),'angular momentum') + call checkval(totmom,totmomin,tol_en,nfailed(2),'linear momentum') + call checkval(etotin+errmax,etotin,tol_en,nfailed(3),'total energy') + do i=1,3 + call update_test_scores(ntests,nfailed(i:i),npass) + enddo + +end subroutine test_sink_binary_gr !----------------------------------------------------------------------- !+ ! Test softening between sink particles. Run a binary orbit @@ -510,7 +680,7 @@ subroutine test_softening(ntests,npass) vxyz_ptmass(2,2) = -v_c2 vxyz_ptmass(3,2) = 0. call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,& - dtsinksink,0,0.,merge_ij,merge_n,dsdt_ptmass) + dtsinksink,0,merge_ij,merge_n,dsdt_ptmass,ti=0.) call compute_energies(t) etotin = etot totmomin = totmom @@ -603,7 +773,7 @@ subroutine test_chinese_coin(ntests,npass,string) iverbose = 1 call update_externalforce(iexternalforce,t,0.) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,& - dtext,iexternalforce,t,merge_ij,merge_n,dsdt_ptmass) + dtext,iexternalforce,merge_ij,merge_n,dsdt_ptmass,ti=t) dtext = 1.e-15 ! take small first step norbit = 0 @@ -1086,7 +1256,7 @@ subroutine test_merger(ntests,npass) ! if (id==master) then call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,0.,merge_ij,merge_n,dsdt_ptmass) + dtsinksink,0,merge_ij,merge_n,dsdt_ptmass,ti=0.) endif fxyz_ptmass(:,:) = 0. call bcast_mpi(epot_sinksink) @@ -1406,8 +1576,8 @@ subroutine test_SDAR(ntests,npass) call group_identify(nptmass,n_group,n_ingroup,n_sing,xyzmh_ptmass,vxyz_ptmass,& group_info,bin_info,nmatrix) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink,& - group_info=group_info,bin_info=bin_info) + dtsinksink,0,merge_ij,merge_n,dsdt_sinksink,& + group_info=group_info,bin_info=bin_info,ti=0.) endif fxyz_ptmass(:,1:nptmass) = 0. dsdt_ptmass(:,1:nptmass) = 0. From c06aeac64811044aa18b9379456ebc045022be85 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 10:43:37 +1100 Subject: [PATCH 18/54] (analysis_kepler) file for analysing TDEs and check if a remnant forms --- src/utils/analysis_kepler.f90 | 1184 ++++++++++++++++++++++----------- 1 file changed, 800 insertions(+), 384 deletions(-) diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index e057510cb..7c0d8d5ef 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -1,8 +1,8 @@ !--------------------------------------------------------------------------! ! The Phantom Smoothed Particle Hydrodynamics code, by Daniel Price et al. ! -! Copyright (c) 2007-2024 The Authors (see AUTHORS) ! +! Copyright (c) 2007-2023 The Authors (see AUTHORS) ! ! See LICENCE file for usage and distribution conditions ! -! http://phantomsph.github.io/ ! +! http://phantomsph.bitbucket.io/ ! !--------------------------------------------------------------------------! module analysis ! @@ -70,7 +70,7 @@ subroutine do_analysis(dumpfile,numfile,xyzh,vxyzu,pmass,npart,time,iunit) 'radius', & 'cell density', & 'cell temperature', & - 'cell radial momentum', & + 'cell radial vel', & 'angular vel (x)', & !ang velocity x component 'angular vel (y)', & !ang velocity y component 'angular vel (z)', & !velocity z component @@ -93,8 +93,9 @@ subroutine do_analysis(dumpfile,numfile,xyzh,vxyzu,pmass,npart,time,iunit) end subroutine do_analysis !---------------------------------------------------------------- !+ - ! This subroutine returns the position and velocity of a - ! particle wrt to the centre of star/max density point + ! This subroutine bins the particles + ! Max density particle is considered as the centre of the remanant + ! !+ !---------------------------------------------------------------- subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid,mass_enclosed,bin_mass,& @@ -106,7 +107,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid use sortutils, only : set_r2func_origin,indexxfunc,r2func_origin use eos, only : equationofstate,entropy,X_in,Z_in,gmw,init_eos use physcon, only : kb_on_mh,kboltz,atomic_mass_unit,avogadro,gg,pi,pc,years - use orbits_data, only : escape + use orbits_data, only : escape,semimajor_axis,period_star use linalg , only : inverse integer,intent(in) :: npart,numfile integer,intent(out) :: ibin,columns_compo @@ -122,10 +123,10 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid real :: pos(3),vel(3),kinetic_i,potential_i,energy_i,vel_mag,pos_mag,pos_next(3),vel_next(3),vel_mag_next,pos_mag_next integer ::particle_bound_bh,last_particle_with_neg_e,energy_verified_no,index_val,i_next,iu1,iu2,iu3,i_prev integer,allocatable :: index_particle_star(:),array_particle_j(:),array_bh_j(:) - integer :: dummy_size,dummy_bins,number_per_bin,count_particles,number_bins,no_particles,big_bins_no,tot_binned_particles + integer :: dummy_size,dummy_bins=5000,number_per_bin,count_particles,number_bins,no_particles,big_bins_no,tot_binned_particles real :: density_i,density_sum,rad_inner,rad_outer,radius_star logical :: double_the_no,escape_star - real :: omega_particle,omega_bin,pos_com(3),vel_com(3),pos_mag_star,vel_mag_star + real :: omega_particle,omega_bin,pos_mag_star,vel_mag_star real :: eni_input,u_i,temperature_i,temperature_sum,mu real :: ponrhoi,spsoundi,rad_vel_i,momentum_i,rad_mom_sum real :: bhmass,pos_prev(3),vel_prev(3),pos_mag_prev,vel_mag_prev @@ -133,235 +134,419 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid real,allocatable :: A_array(:), Z_array(:) real,allocatable :: interpolate_comp(:,:),composition_i(:),composition_sum(:) real :: ke_star,u_star,total_star,distance_from_bh,vel_from_bh,vel_at_infinity + real :: period_val + real,allocatable :: count_particles_temp(:),temp_array_new(:),temp_array_diff(:),temp_all_particles(:) + real :: max_temp=8000.,temp_cut=0. + real, dimension(200) :: temp_array_test + logical :: temp_found=.false. + integer :: count_loops_temp = 0 + real,allocatable :: temp_npart(:),den_npart(:),pos_npart(:),vel_npart(:),pos_vec_npart(:,:),vel_vec_npart(:,:) + real,allocatable :: h_npart(:),tot_eng_npart(:),ke_npart(:),pe_npart(:) + integer,allocatable :: sorted_index_npart(:),bound_index(:),sorted_index(:) + real :: pos_i,vel_i,pos_vec_i(3),vel_vec_i(3),ke_i,pe_i,tot_e_sum + real :: tot_rem_mass,pos_com(3),vel_com(3),pos_com_mag,vel_com_mag + integer :: index_sort,double_count + real,allocatable :: pos_wrt_bh(:,:),vel_wrt_bh(:,:),interp_comp_npart(:,:) + real :: vphi_i,R_mag_i,vphi_sum,R_vec(2),vphi_avg,omega_vec(3),rad_cyl,breakup + + ! use adiabatic EOS ieos = 2 call init_eos(ieos,ierr) gmw=0.61 - bhmass=1. + ! Set mass of black hole in code units + bhmass = 1 + ! Set initial cut based on temperature as zero K + temp_cut = 0. + allocate(temp_all_particles(npart)) ! performing a loop to determine maximum density particle position do j = 1,npart den_all(j) = rhoh(xyzh(4,j),pmass) enddo + + ! Save the location of max density particle location = maxloc(den_all,dim=1) - print*,location,"location of max density" - ! Determining centre of star as max density particle + print*,location,"LOCATION OF MAX" + ! Determining centre of star as max density particle. xpos(:) = xyzh(1:3,location) vpos(:) = vxyzu(1:3,location) distance_from_bh = sqrt(dot_product(xpos(:),xpos(:))) vel_from_bh = sqrt(dot_product(vpos(:),vpos(:))) - print*,"******************" - print*,distance_from_bh*udist,"distance from bh",vel_from_bh*unit_velocity,"velfrom bh" - print*,"*******************" - ! sorting particles + + ! sorting particles by radius. Letting the max density particle be the centre of the star. + ! This here for npart particles call set_r2func_origin(xpos(1),xpos(2),xpos(3)) call indexxfunc(npart,r2func_origin,xyzh,iorder) + + ! Get the composition array for all the particles call composition_array(interpolate_comp,columns_compo,comp_label) - call particles_bound_to_star(xpos,vpos,xyzh,vxyzu,pmass,npart,iorder,energy_verified_no,last_particle_with_neg_e,array_particle_j,array_bh_j,interpolate_comp,columns_compo,comp_label,numfile) - call assign_atomic_mass_and_number(comp_label,A_array,Z_array) - print*,array_particle_j(energy_verified_no),"Last particle indes",last_particle_with_neg_e - print*,energy_verified_no,"energy_verified_no",size(array_particle_j) + + ! Call the following function to obatin important information about each particle + call calculate_npart_quantities(npart,iorder,numfile,xyzh,vxyzu,pmass,xpos,vpos,comp_label,& + interpolate_comp,columns_compo,temp_npart,den_npart,pos_npart,vel_npart,& + pos_vec_npart,vel_vec_npart,tot_eng_npart,sorted_index_npart,ke_npart,pe_npart,& + pos_wrt_bh,vel_wrt_bh,h_npart,interp_comp_npart) + + ! This determines the particles bound to the star. Also removes the streams from the data + call particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sorted_index_npart,bound_index,sorted_index,energy_verified_no,& + last_particle_with_neg_e,ke_npart,pe_npart,den_npart) + + ! This determins how many particles would be added to the bins. We set a min no of bins as 500 in the code and using that along with the particles + ! that we consider as being part of the remnant implies that the model returns what the max number of particles I would have to add to a bin to get 500 bins call particles_per_bin(energy_verified_no,number_per_bin) - tot_binned_particles = 0 big_bins_no = number_per_bin + tot_binned_particles = 0 no_particles = 1 - dummy_bins = 5000 ibin = 1 double_the_no = .True. - + print*,size(bound_index),"BOUND INDEX ARRAY",energy_verified_no,"energy verified no" + ! Define bins arrays allocate(density(dummy_bins),rad_grid(dummy_bins),mass_enclosed(dummy_bins),bin_mass(dummy_bins),temperature(dummy_bins),rad_vel(dummy_bins),angular_vel_3D(3,dummy_bins)) + allocate(composition_i(columns_compo),composition_sum(columns_compo),composition_kepler(columns_compo,dummy_bins)) + + print*,"WORKED1" density_sum = 0. temperature_sum = 0. rad_mom_sum = 0. L_sum(:) = 0. I_sum(:,:) = 0. count_particles = 0 - allocate(composition_i(columns_compo)) - allocate(composition_sum(columns_compo)) - allocate(composition_kepler(columns_compo,dummy_bins)) composition_sum(:) = 0. composition_i(:) = 0. - - ! writing files with angular velocity info - open(1,file="particleOmega.info") - write(1,*) "[pos]"," ","[omega]" - open(2,file="binOmega.info") - write(2,*) "[pos]"," ","[omega]" - open(3,file="radius_of_bins.info") - write(3,*) "[ibin]"," ","[rad_inner]"," ","[rad_outer]"," ","[Position rad next]"," ","[particles in bin]" + pos_com(:) = 0. + vel_com(:) = 0. + tot_e_sum = 0. + vphi_sum = 9. + ! Write a comp file that includes informtation about the remnant only write(output,"(a4,i5.5)") 'compo',numfile open(4,file=output) - write(4,"(25(a22,1x))") & + write(4,"(32(a22,1x))") & "i", & "ibin", & "radius", & "x", & "y", & + "z", & + "radial_vel",& + 'temp',& + 'density',& + comp_label,& + 'omega',& + 'breakup',& + 'j',& + 'index_sort' + + + + ! this will determine when sorted indices are part of the star. We would also need the normal i indicies of the sorted particles + ! Using this we can determine which sorted particles are part of the array and then use the sorted information to calculate all the + ! quantities we require for the project + print*,size(bound_index),"bound index size",energy_verified_no,"energy_verified_no" + open(14,file="big_loop_clean.txt") + write(output,"(a4,i5.5)") 'vphi',numfile + open(10,file=output) + write(10,"(2(a22,1x))") & + "rad",& + "vphi" + + write(output,"(a4,i5.5)") 'vbra',numfile + open(111,file=output) + write(111,"(2(a22,1x))") & + "rad",& + "vbreak" + write(output,"(a4,i5.5)") 'rot_i',numfile + open(11,file=output) + open(41,file="remnant") + write(41,"(6(a22,1x))") & "x", & - comp_label - - pos_com(:) = 0. - vel_com(:) = 0. - ! Now we calculate the different quantities of the particles and bin them - do j=1,energy_verified_no - i = iorder(array_particle_j(j)) - if (j /= energy_verified_no) then - i_next = iorder(array_particle_j(j+1)) - else - i_next = iorder(array_particle_j(j)) - endif - - call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos,vel,i,pos_mag,vel_mag) - - ! calculating centre of mass position and velocity wrt black hole - pos_com(:) = pos_com(:) + xyzh(1:3,i)*pmass - vel_com(:) = vel_com(:) + vxyzu(1:3,i)*pmass - - if (j /= energy_verified_no) then - call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos_next,vel_next,i_next,pos_mag_next,vel_mag_next) - endif - - count_particles = count_particles + 1 - if (count_particles == 1) then - rad_inner = pos_mag - !print*,j,"j","first",rad_inner,"rad_inner",count_particles - endif - - !print*,pos_mag_next-pos_mag,"difference in pos mag of next and current particle",i,"i",i_next,"i_next",j,"j",j+1,"jnext" - call no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner) - if (number_per_bin == count_particles) then - rad_outer = pos_mag - endif - ! composition - if (columns_compo /= 0) then - composition_i(:) = interpolate_comp(:,i) - endif - composition_sum(:) = composition_sum(:) + composition_i(:) - - write(4,'(i9,1x,i5,1x,23(e18.10,1x))') & - i, & - ibin, & - pos_mag*udist, & - pos(1)*udist, & - pos(2)*udist, & - pos(3)*udist, & - composition_i(:) - ! calculate mean molecular weight that is required by the eos module using - ! the mass fractions for each particle. - ! do not consider neutron which is the first element of the composition_i array. - - call calculate_mu(A_array,Z_array,composition_i,columns_compo,mu) - - gmw = 1./mu - ! Density - density_i = rhoh(xyzh(4,i),pmass) - density_sum = density_sum + density_i - - ! Temperature - u_i = vxyzu(4,i) - eni_input = u_i - call equationofstate(ieos,ponrhoi,spsoundi,density_i,xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi=temperature_i,eni=eni_input) - temperature_sum = temperature_sum + temperature_i - - ! Radial momentum - ! we skip the first particle as its the one that exists at the center of - ! star and hence will give infinite rad_vel as rad = 0. - if (pos_mag > 0.) then - rad_vel_i = dot_product(vel(:),pos(:))/pos_mag - momentum_i = rad_vel_i*pmass - rad_mom_sum = rad_mom_sum + momentum_i + "y", & + "z", & + "m", & + "h", & + 'rho' + + do i = 1,energy_verified_no + ! get the sorted index of bound particles + j = bound_index(i) + index_sort = sorted_index(i) + count_particles = count_particles + 1 + ! Calculate the position and velocity VEC of COM + pos_com(:) = pos_com(:) + xyzh(1:3,index_sort)*pmass + vel_com(:) = vel_com(:) + vxyzu(1:3,index_sort)*pmass + + ! Obtain the values for each particle that is bound/ part of remnant + density_i = den_npart(j) + temperature_i = temp_npart(j) + pos_i = pos_npart(j) + vel_i = vel_npart(j) + pos_vec_i(:) = pos_vec_npart(:,j) + vel_vec_i(:) = vel_vec_npart(:,j) + R_vec(:) = pos_vec_i(1:2) + R_mag_i = norm2(R_vec) + ke_i = ke_npart(j) + pe_i = pe_npart(i) + write(14,*) i,j,pos_i,vel_i,pos_vec_i(1)*udist,pos_vec_i(2)*udist,pos_vec_i(3)*udist,temperature_i,density_i*unit_density,sorted_index(i) + + ! Calculate the angular velocity in cylindrical coordinates + vphi_i = vel_vec_i(1)*(-pos_vec_i(2)/R_mag_i) + vel_vec_i(2)*(pos_vec_i(1)/R_mag_i) + vphi_i = vphi_i/R_mag_i + + ! Position magnitude of the next bound particle + if (i /= energy_verified_no) then + pos_mag_next = pos_npart(j+1) + endif + + ! composition + if (columns_compo /= 0) then + composition_i(:) = interp_comp_npart(:,j) + endif + + if (index_sort == 13) then + print*,composition_i(:),"compo in big look",j,"j",i,"i",index_sort,"index_sort2" endif - ! Angular momentum - call cross_product3D(pos(:),vel(:),Li(:)) - L_i(:) = Li(:)*pmass - L_sum(:) = L_sum(:) + L_i(:) - if (pos_mag == 0.) then + ! Calculate extra quantities + if (pos_i > 0.) then + ! Radial velocity + rad_vel_i = dot_product(vel_vec_i(:),pos_vec_i)/pos_i + momentum_i = rad_vel_i*pmass + endif + ! Angular momentum + call cross_product3D(pos_vec_i(:),vel_vec_i(:),Li(:)) + L_i(:) = Li(:)*pmass + ! Moment of Inertia Matrix + call moment_of_inertia(pos_vec_i,pos_i,pmass,i_matrix) + + if (pos_i == 0.) then omega_particle = 0. - else - omega_particle = sqrt(dot_product(Li(:)/(pos_mag**2),Li(:)/(pos_mag**2))) - endif - - write(1,*)pos_mag,omega_particle - ! Moment of inertia - call moment_of_inertia(pos,pos_mag,pmass,i_matrix) - I_sum(:,:) = I_sum(:,:) + i_matrix(:,:) - - if (count_particles==number_per_bin .or. j==energy_verified_no) then - tot_binned_particles = tot_binned_particles+count_particles - call radius_of_remnant(array_particle_j,count_particles,number_per_bin,j,energy_verified_no,xpos,vpos,xyzh,vxyzu,iorder,pos_mag,radius_star) - rad_grid(ibin) = radius_star - density(ibin) = density_sum/count_particles - mass_enclosed(ibin) = tot_binned_particles*pmass - bin_mass(ibin) = count_particles*pmass - temperature(ibin) = max(temperature_sum/count_particles,1e3) - rad_vel(ibin) = rad_mom_sum/bin_mass(ibin) !Radial vel of each bin is summation(vel_rad_i*m_i)/summation(m_i) - if (count_particles == 1) then - if (pos_mag==0.) then - angular_vel_3D(:,ibin) = L_sum(:) - else - angular_vel_3D(:,ibin) = L_sum(:) / (pos_mag**2*pmass) - endif - else - inverse_of_i = inverse(I_sum, 3) - L_reshape = reshape(L_sum(:),(/3,1/)) - matrix_result = matmul(inverse_of_i,L_reshape) - omega = reshape(matrix_result,(/3/)) - angular_vel_3D(:,ibin) = omega - endif - omega_bin = sqrt(dot_product(angular_vel_3D(:,ibin),angular_vel_3D(:,ibin))) - write(2,*)pos_mag,omega_bin - composition_kepler(:,ibin) = composition_sum(:)/count_particles - write(3,*) ibin,rad_inner,rad_outer,pos_mag_next,count_particles - count_particles = 0 - density_sum = 0. - temperature_sum = 0. - rad_mom_sum = 0. - L_sum(:) = 0. - I_sum(:,:) = 0. - composition_sum(:) = 0. - ibin = ibin+1 - endif + else + omega_vec(:) = Li(:)/pos_i**2 + omega_particle = norm2(omega_vec) + endif + breakup = ((gg*i*pmass*umass)/(pos_i*udist)**3)**(0.5) + write(11,*) pos_i,omega_particle/utime,vphi_i/utime,pos_vec_i(1),pos_vec_i(2),pos_vec_i(3) + write(4,'(i9,1x,i5,1x,27(e18.10,1x),1x,i10,1x,i10)') & + i, & + ibin, & + pos_i*udist, & + pos_vec_i(1)*udist, & + pos_vec_i(2)*udist, & + pos_vec_i(3)*udist, & + rad_vel_i,& + temperature_i,& + density_i*unit_density,& + composition_i(:),& + omega_particle/utime,& + breakup,& + j,& + index_sort + + write(41,'(6(e18.10,1x))') & + pos_vec_i(1), & + pos_vec_i(2), & + pos_vec_i(3), & + pmass, & + h_npart(j), & + density_i + + ! Count particles keeps track of particles in a bin. + ! Rad_inner is the radius of the first particle that is added to a bin + if (count_particles == 1) then + rad_inner = pos_i + endif + ! Calculate how many particles will go in a bin + call no_per_bin(i,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner,double_count) + + ! We sum the quantities we want to save for the particles + density_sum = density_sum + density_i + temperature_sum = temperature_sum + temperature_i + rad_mom_sum = rad_mom_sum + momentum_i + L_sum(:) = L_sum(:) + L_i(:) + I_sum(:,:) = I_sum(:,:) + i_matrix(:,:) + composition_sum(:) = composition_sum(:) + composition_i(:) + tot_e_sum = ke_i + pe_i + tot_e_sum + vphi_sum = vphi_sum + vphi_i + + ! We check id the count_particles is the same as the number_per_bin + ! If true then we save the bin information + !if (count_particles==number_per_bin .or. i==energy_verified_no) then + if (count_particles==number_per_bin) then + ! Total particles binned. Should be the same as energy_verified_no at the end + tot_binned_particles = tot_binned_particles+count_particles + + ! Calculate the bin quantities + call radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy_verified_no,pos_npart,radius_star,pos_vec_npart,rad_cyl) + + rad_grid(ibin) = radius_star + density(ibin) = density_sum/count_particles + mass_enclosed(ibin) = tot_binned_particles*pmass + bin_mass(ibin) = count_particles*pmass + ! Change the temperature of particles if its < 1.e3 to 1.e3 + if (temperature_sum < 1.e3) then + print*,"THIS BIN HAS TEMP LESS THAN 1000 K",temperature_sum + endif + temperature(ibin) = max(temperature_sum/count_particles,1e3) + rad_vel(ibin) = rad_mom_sum/bin_mass(ibin) !Radial vel of each bin is summation(vel_rad_i*m_i)/summation(m_i) + if (count_particles == 1) then + if (rad_grid(ibin)==0.) then + + angular_vel_3D(:,ibin) = L_sum(:) + else + + angular_vel_3D(:,ibin) = L_sum(:) / (pos_i**2*pmass) + endif + else + inverse_of_i = inverse(I_sum, 3) + L_reshape = reshape(L_sum(:),(/3,1/)) + matrix_result = matmul(inverse_of_i,L_reshape) + omega = reshape(matrix_result,(/3/)) + angular_vel_3D(:,ibin) = omega + endif + composition_kepler(:,ibin) = composition_sum(:)/count_particles + vphi_avg = vphi_sum/count_particles + breakup = ((gg*mass_enclosed(ibin)*umass)/(rad_grid(ibin)*udist)**3)**(0.5) + if (norm2(angular_vel_3D(:,ibin)) > 0) then + write(10,*) udist*rad_grid(ibin),norm2(angular_vel_3D(:,ibin))/utime + write(111,*) udist*rad_grid(ibin),breakup + endif + + !print*,count_particles,"count particles",ibin,"ibin",rad_grid(ibin),"rad",number_per_bin,"number per bin" + ! Reset the sum values + count_particles = 0 + density_sum = 0. + temperature_sum = 0. + rad_mom_sum = 0. + L_sum(:) = 0. + I_sum(:,:) = 0. + composition_sum(:) = 0. + vphi_sum = 0. + ibin = ibin+1 + number_per_bin = big_bins_no + endif enddo - print*,iu1,"iu",iu2,"iu2" - close(1) - close(2) - close(3) + close(111) close(4) + close(14) + close(10) + close(11) + close(41) + ! We want to set the radial and angular velocity of the first bin as the same as the second bin so that they are not zero + angular_vel_3D(:,1) = angular_vel_3D(:,2) + rad_vel(1) = rad_vel(2) ibin = ibin-1 - print*,mass_enclosed(ibin)*umass,"enclodsed mass",pos_com,"pos com" - print*,rad_grid(ibin),"Radius MAX" - pos_com(:) = pos_com(:)/mass_enclosed(ibin) - print*,pos_com,"pos of com" - vel_com(:) = vel_com(:)/mass_enclosed(ibin) - print*,pos_com,"pos_com",xpos,"xpos",vel_com,"vel com",vpos,"vpos" - print*,ibin,"ibin",tot_binned_particles - pos_mag_star = sqrt(dot_product(pos_com,pos_com)) - vel_mag_star = sqrt(dot_product(vel_com,vel_com)) - print*,"bhmass*umass",bhmass*umass - print*,"-------------------------------------------------------------------------" - print*,escape(vel_mag_star*unit_velocity,bhmass*umass,pos_mag_star*udist) - print*,"-------------------------------------------------------------------------" - ke_star = 0.5*(vel_mag_star*unit_velocity)**2 - u_star = -gg*(bhmass*umass)/(pos_mag_star*udist) - print*,"--------------" - print*,bhmass*umass,"BH mass", pos_mag_star*udist, "Pos Mag star",vel_mag_star*unit_velocity,"Vel Mag Star" - print*,"--------------" - total_star = u_star+ke_star - print*,umass,"umass",gg,"gg" - print*,total_star,"total_star",u_star,"ustar",ke_star,"ke_star" - print*,mass_enclosed(ibin),"/mass_enclosed(ibin)",mass_enclosed(ibin)*umass - vel_at_infinity = sqrt(2.*total_star) - if (isnan(vel_at_infinity)) then - vel_at_infinity = 0. - endif - print*,vel_at_infinity*1.e-5,"vel at infinity in Km/s" - print*,umass,"umass",udist,"udist",unit_density,"unit_density",unit_velocity,"unit_velocity",utime,"utime" - ! write information to the dump_info file - call write_compo_wrt_bh(xyzh,vxyzu,xpos,vpos,pmass,npart,iorder,array_bh_j,interpolate_comp,columns_compo,comp_label,energy_verified_no,last_particle_with_neg_e) + tot_rem_mass = mass_enclosed(ibin) + + ! Get the COM pos and vel magnitudes + call determine_pos_vel_com(vel_com,pos_com,pos_com_mag,vel_com_mag,tot_rem_mass) + print*,pos_i,"Radius of last particle in code units" + print*,pos_com,"POS COM",vel_com,"VEL COM" + print*,xpos,"XPOS",vpos,"VPOS",mass_enclosed(ibin)*umass,"mass" + print*,norm2(xpos),norm2(pos_com),"pos mag",norm2(pos_com)/170.33676805,"how far from rt?" + print*,norm2(vpos),norm2(vel_com),"vel mag" + ! Next we calculate the energy for the COM and determine if its bound or unbound + call determine_bound_unbound(vel_com,pos_com,pos_com_mag,vel_com_mag,bhmass,tot_rem_mass,pmass,& + total_star,ke_star,u_star,vel_at_infinity) + print*,tot_e_sum,"TOT E SUM" call write_dump_info(numfile,density(1),temperature(1),mass_enclosed(ibin),xpos,rad_grid(ibin),distance_from_bh,& - pos_mag_star,vel_mag_star,total_star,ke_star,u_star,time,vel_at_infinity) -end subroutine phantom_to_kepler_arrays + pos_com_mag,vel_com_mag,total_star,ke_star,u_star,time,vel_at_infinity) + end subroutine phantom_to_kepler_arrays + !---------------------------------------------------------------- + !+ + ! This subroutine returns the magntitude of the COM pos and vel + !+ + !---------------------------------------------------------------- + subroutine determine_pos_vel_com(vel_com,pos_com,pos_com_mag,vel_com_mag,tot_rem_mass) + real,intent(inout),dimension(3) :: vel_com,pos_com + real,intent(in) :: tot_rem_mass + real,intent(out) :: vel_com_mag,pos_com_mag + + ! Divide the pos_com and vel_com with the total mass enclosed + pos_com(:) = pos_com(:)/tot_rem_mass + vel_com(:) = vel_com(:)/tot_rem_mass + + pos_com_mag = norm2(pos_com) + vel_com_mag = norm2(vel_com) + + end subroutine determine_pos_vel_com + !---------------------------------------------------------------- + !+ + ! This subroutine returns if remnant is bound or unbound + !+ + !---------------------------------------------------------------- + subroutine determine_bound_unbound(vel_com,pos_com,pos_com_mag,vel_com_mag,bhmass,tot_rem_mass,pmass,& + tot_energy_remnant_com,ke_star,pe_star,vel_at_infinity) + use units , only : udist,umass,unit_velocity + use physcon,only : gg + + real,intent(in) :: vel_com_mag,pos_com_mag,bhmass,tot_rem_mass,pmass + real,intent(in) :: pos_com(3),vel_com(3) + real,intent(out):: ke_star,pe_star,tot_energy_remnant_com,vel_at_infinity + real :: bhmass_cgs,rem_mass + real :: period_val,vel_com_cgs(3),pos_com_cgs(3) + real :: er, ar + + bhmass_cgs = bhmass*umass + rem_mass = tot_rem_mass*umass + vel_com_cgs(:) = vel_com(:)*unit_velocity + pos_com_cgs(:) = pos_com(:)*udist + ! Check if Total specific Energy of COM is < 0 or not (in cgs units) + ke_star = 0.5*(vel_com_mag*unit_velocity)**2 + pe_star = -gg*bhmass_cgs/(pos_com_mag*udist) + tot_energy_remnant_com = ke_star + pe_star + print*,vel_com_cgs,"CGS vel com",pos_com_cgs,"CGS pos com" + + if (tot_energy_remnant_com < 0.) then + print*, "REMNANT IS BOUND TO THE BLACKHOLE",tot_energy_remnant_com,"energy val" + call determine_orbital_params(rem_mass,bhmass_cgs,pos_com_cgs,vel_com_cgs,period_val) + ar = -gg*0.5*(bhmass_cgs + rem_mass)/tot_energy_remnant_com + er = 1 - (56.77892268*udist)/ar + print*,"******************" + print*,ar/1.496e13,"ar",er,"er" + elseif (tot_energy_remnant_com == 0.) then + print*, "Parabolic orbit!" + else + print*, "REMNANT IS UNBOUND" + call determine_inf_vel(tot_energy_remnant_com,vel_at_infinity) + print*,"VELOCITY OF REMNANT IN kms/s :",vel_at_infinity*1e-5 + ar = gg*0.5*(bhmass_cgs + rem_mass)/tot_energy_remnant_com + er = 1 + (56.77892268*udist)/ar + print*,"******************" + print*,ar/1.496e13,"ar",er,"er" + endif + + print*,pmass*(0.5*vel_com_mag**2 - (1/pos_com_mag)),"ENERGY OF COM" + end subroutine determine_bound_unbound + !---------------------------------------------------------------- + !+ + ! This subroutine returns the vel infinity for the remnant + ! if its unbound + !+ + !---------------------------------------------------------------- + subroutine determine_orbital_params(rem_mass,bhmass_cgs,pos_com,vel_com,period_val) + use orbits_data, only : escape,semimajor_axis,period_star,eccentricity_star + real,intent(in) :: rem_mass,bhmass_cgs,pos_com(3),vel_com(3) + real,intent(out):: period_val + real :: ecc_val + + ecc_val = eccentricity_star(rem_mass,bhmass_cgs,pos_com,vel_com) + print*,ecc_val,"ECCENTRICITY VALUE!!!!",rem_mass,"rem mass", bhmass_cgs,"bhmass cgs",pos_com,"com pos",vel_com,"com vel" + period_val = period_star(rem_mass,bhmass_cgs,pos_com,vel_com) + print*,period_val,"PERIOD OF STAR" + + end subroutine determine_orbital_params + !---------------------------------------------------------------- + !+ + ! This subroutine returns the oribital properties + !+ + !---------------------------------------------------------------- + subroutine determine_inf_vel(tot_energy_remnant_com,vel_at_infinity) + real,intent(in) :: tot_energy_remnant_com + real,intent(out):: vel_at_infinity + + vel_at_infinity = sqrt(2.*tot_energy_remnant_com) + + end subroutine determine_inf_vel !---------------------------------------------------------------- !+ ! This subroutine returns the position and velocity of a @@ -386,123 +571,85 @@ end subroutine particle_pos_and_vel_wrt_centre ! This subroutine returns which particles are bound to the star !+ !---------------------------------------------------------------- -subroutine particles_bound_to_star(xpos,vpos,xyzh,vxyzu,pmass,npart,iorder,energy_verified_no,last_particle_with_neg_e,array_particle_j,array_bh_j,interpolate_comp,columns_compo,comp_label,numfile) - use units , only : udist,umass,unit_velocity,unit_energ - use vectorutils, only : cross_product3D - use part, only : rhoh,poten - use centreofmass, only : get_centreofmass - use sortutils, only : set_r2func_origin,indexxfunc,r2func_origin - use eos, only : equationofstate,entropy,X_in,Z_in,gmw,init_eos - use physcon, only : gg - - integer,intent(in) :: npart,iorder(:),numfile - real,intent(in) :: xyzh(:,:),vxyzu(:,:),xpos(:),vpos(:) - real,intent(in) :: pmass - character(len=20),intent(in) :: comp_label(:) - real,intent(in) :: interpolate_comp(:,:) - integer,intent(in) :: columns_compo - integer,intent(out) :: energy_verified_no,last_particle_with_neg_e - integer,allocatable,intent(out) :: array_particle_j(:),array_bh_j(:) - - character(len=120) :: output - integer,allocatable :: index_particle_star(:),index_particle_bh(:) - integer :: i,j,dummy_size,index_val,particle_bound_bh,index_val_bh,count_val,count_val_unbound,count_bound_both - real :: potential_wrt_bh,kinetic_wrt_bh,tot_wrt_bh,pos(3),vel(3) - real :: potential_i, kinetic_i,energy_i,pos_mag,vel_mag - logical :: bound_to_bh,bound_to_star - real,allocatable :: composition_i(:) - - bound_to_bh = .false. - bound_to_star = .false. - particle_bound_bh = 0 - energy_verified_no = 0 - index_val = 1 - index_val_bh = 1 - dummy_size = 1e8 - count_val = 0 - count_val_unbound = 0 - count_bound_both = 0 - - write(output,"(a8,i5.5)") 'compfull',numfile - open(5,file=output) - write(5,"(18(a22,1x))") & - comp_label - - allocate(index_particle_star(dummy_size),index_particle_bh(dummy_size)) - allocate(composition_i(columns_compo)) - do j = 1, npart - - i = iorder(j) !Access the rank of each particle in radius. - potential_wrt_bh = -(gg*umass*pmass*umass)/(sqrt(dot_product(xyzh(1:3,i),xyzh(1:3,i)))*udist) - kinetic_wrt_bh = 0.5*pmass*umass*dot_product(vxyzu(1:3,i),vxyzu(1:3,i))*unit_velocity**2 - tot_wrt_bh = potential_wrt_bh+ kinetic_wrt_bh+vxyzu(4,i)*pmass*unit_energ - if (tot_wrt_bh < 0.) then - bound_to_bh = .True. - endif - if (columns_compo /= 0) then - composition_i(:) = interpolate_comp(:,i) - endif - write(5,'(18(e18.10,1x))') & - composition_i(:) - !the position of the particle is calculated by subtracting the point of - !highest density. - !xyzh is position wrt the black hole present at origin. - call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos,vel,i,pos_mag,vel_mag) - - !calculate the position which is the location of the particle. - potential_i = poten(i) - kinetic_i = 0.5*pmass*vel_mag**2 - - energy_i = potential_i + kinetic_i + vxyzu(4,i)*pmass - - !if energy is less than 0, we have bound system. We can accept these particles. - if (energy_i < 0. .and. kinetic_i < 0.5*abs(potential_i)) then - bound_to_star = .True. - energy_verified_no = energy_verified_no + 1 - last_particle_with_neg_e = j - index_particle_star(index_val) = j - index_val = index_val+1 - endif - - if (bound_to_bh == .True. .and. bound_to_star == .false.) then - count_val = count_val + 1 - index_particle_bh(index_val_bh) = j - particle_bound_bh = particle_bound_bh +1 - index_val_bh = index_val_bh+1 - endif - if (bound_to_bh == .True. .and. bound_to_star == .True.) then - count_bound_both = count_bound_both + 1 - endif - - if (bound_to_bh == .false. .and. bound_to_star == .false.) then - count_val_unbound = count_val_unbound + 1 - endif - bound_to_bh = .false. - bound_to_star = .false. - enddo - close(5) - print*,"===================================" - print*,count_val,"count val",count_val_unbound,"unbound count",count_bound_both,"count_bound_both" - print*,"====================================" - !next we save the index of particles which are part of star into a new array - allocate(array_particle_j(energy_verified_no)) - do i=1,energy_verified_no - array_particle_j(i) = index_particle_star(i) - enddo - print*,"-------" - print*,npart,"npart in determing particles" - print*,"-------" - ! we save the index of the particles bound to the SMBH - allocate(array_bh_j(particle_bound_bh)) - do i=1,particle_bound_bh - array_bh_j(i) = index_particle_bh(i) - enddo - - print*,"--------" - print*,particle_bound_bh,"particle bound to the bh",size(array_bh_j),"array bh j" - print*,"Size of array with particles",size(array_particle_j) - print*,"--------" -end subroutine particles_bound_to_star + subroutine particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sorted_index_npart,bound_index,sorted_index,bound_particles_no,& + last_particle_with_neg_e,ke_npart,pe_npart,den_npart) + + real,intent(in) :: temp_npart(:),tot_eng_npart(:),ke_npart(:),pe_npart(:),pos_npart(:),den_npart(:) + integer,intent(in) :: sorted_index_npart(:) + integer,intent(in) :: npart + + integer,allocatable,intent(out) :: bound_index(:),sorted_index(:) + integer,intent(out) :: bound_particles_no,last_particle_with_neg_e + integer :: energy_verified_no,i + real,allocatable :: index_particle_star(:),temp_bound(:),temp_particles(:) + integer,allocatable :: index_bound(:),index_bound_sorted(:),index_bound_new(:) + real :: max_temp=8000.,index_val + integer :: count_loops_temp=0 + logical :: temp_found,implement_temp_cut + real :: temp_cut + + ! Implement temp cut would try to remove the strems. But if you only want + ! to consider what is bound based on energy condition set this parameter to False + implement_temp_cut = .true. + bound_particles_no = 0 + temp_found = .false. + energy_verified_no = 0 + allocate(index_particle_star(npart),index_bound(npart),temp_particles(npart)) + open(unit=10, file="particle_index_clean") + ! Use the sorted array information and check the energy condition first + do i=1,npart + !if energy is less than 0, we have bound system. We can accept these particles. + if (tot_eng_npart(i) < 0. .and. ke_npart(i) < 0.5*abs(pe_npart(i))) then + write(10,*) i,temp_npart(i),pos_npart(i),sorted_index_npart(i) + energy_verified_no = energy_verified_no + 1 + ! Save the index of these particles + ! this is because sometimes even if a particle is farther it could be could but the one before could be unbound + last_particle_with_neg_e = i + index_particle_star(energy_verified_no) = sorted_index_npart(i) + index_bound(energy_verified_no) = i + temp_particles(energy_verified_no) = temp_npart(i) + print*,"YES BOUND",i,"i" + endif + enddo + close(10) + allocate(temp_bound(energy_verified_no), index_bound_sorted(energy_verified_no),index_bound_new(energy_verified_no)) + do i = 1,energy_verified_no + temp_bound(i) = temp_particles(i) + ! This is the sorted index + index_bound_sorted(i) = index_particle_star(i) + index_bound_new(i) = index_bound(i) + enddo + if (implement_temp_cut) then + ! next we loop over the bound particles based on energy condition to find the temp_cut + ! As the models would need ages to evolve and I can not do that due to how slow some models run, we have streams around the remnants + ! Hence, we bin the temperature particles and try to find the cut in temperature + ! But using a temperature cut of 8000 K implies that if I use a model that has streams at high temperature (>1e4 K) because the remnant has just formed + ! then I would not get rid of the correct particles + ! Hence, we keep looping until the temperature being returned is the same as the max_temp + count_loops_temp = count_loops_temp + 1 + call calculate_temp_cut(temp_bound,energy_verified_no,temp_cut,max_temp,temp_found,count_loops_temp,den_npart) + max_temp = max_temp + 1000 + + allocate(bound_index(energy_verified_no),sorted_index(energy_verified_no)) + ! use temp_cut to ignore the streams + do i = 1,energy_verified_no + if (temp_bound(i) > temp_cut) then + bound_particles_no = bound_particles_no + 1 + ! Save the sorted array indices only + bound_index(bound_particles_no) = index_bound_new(i) + sorted_index(bound_particles_no) = index_bound_sorted(i) + if (sorted_index(bound_particles_no) == 13) then + print*, bound_index(bound_particles_no),"bound_index(bound_particles_no)" + endif + endif + enddo + else + bound_particles_no = energy_verified_no + allocate(bound_index(energy_verified_no),sorted_index(energy_verified_no)) + bound_index(:) = index_bound_new(:) + sorted_index(:) = index_bound_sorted(:) + endif + end subroutine particles_bound_to_star !---------------------------------------------------------------- !+ ! This subroutine returns number of particles that can be put into @@ -518,7 +665,7 @@ subroutine particles_per_bin(energy_verified_no,number_per_bin) number_bins = 500 number_per_bin = (energy_verified_no/number_bins) if (mod(energy_verified_no,number_bins) /= 0) then - number_per_bin = 1 + number_per_bin + number_per_bin = 1+ number_per_bin endif end subroutine particles_per_bin @@ -528,59 +675,87 @@ end subroutine particles_per_bin ! on some conditions !+ !---------------------------------------------------------------- -subroutine no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner) - integer,intent(inout) :: number_per_bin +subroutine no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner,double_count) + integer,intent(inout) :: number_per_bin,double_count logical,intent(inout) :: double_the_no integer,intent(in) :: count_particles,big_bins_no,j,energy_verified_no real,intent(in) :: pos_mag_next,rad_inner + real,parameter :: min_no=5 + integer :: i + real :: avg_val,diff_val + avg_val = (pos_mag_next+rad_inner)/2 + diff_val = (pos_mag_next-rad_inner) + + open(15,file="rad_to_bin",status='old', action='write', iostat=i) + if (i /= 0) then + ! File does not exist, create it + open(unit=15, file="rad_to_bin", status='new', action='write', iostat=i) + end if if (j==1) then number_per_bin = 1 + double_count = 1 elseif (double_the_no==.True. .and. count_particles==1) then - number_per_bin = number_per_bin*2 + double_count = double_count*2 + number_per_bin = double_count if (number_per_bin >= big_bins_no) then number_per_bin = big_bins_no double_the_no = .False. endif else - if (pos_mag_next - rad_inner > 0.1) then + if (double_the_no == .False. .and. j .ne. count_particles) then + if (100*(pos_mag_next-rad_inner)/rad_inner > 30) then + !print*,(((pos_mag_next-rad_inner)/rad_inner)*100),"per inc",j,"j",count_particles,"count_particles" + write(15,*) pos_mag_next,rad_inner,j,number_per_bin number_per_bin=count_particles - if (number_per_bin < 10) then - number_per_bin = 10 - endif + !if (number_per_bin < min_no) then + ! number_per_bin = min_no + ! endif + endif endif endif if (j==energy_verified_no) then number_per_bin = count_particles endif - end subroutine no_per_bin !---------------------------------------------------------------- !+ ! This subroutine returns radius of the remnant !+ !---------------------------------------------------------------- -subroutine radius_of_remnant(array_particle_j,count_particles,number_per_bin,j,energy_verified_no,xpos,vpos,xyzh,vxyzu,iorder,pos_mag,radius_star) - integer,intent(in) :: count_particles,number_per_bin,j,energy_verified_no,iorder(:),array_particle_j(:) - real,intent(in) :: xyzh(:,:),vxyzu(:,:),xpos(:),vpos(:),pos_mag - real,intent(out) :: radius_star - - real :: pos_mag_next,vel_mag_next,pos_next(3),vel_next(3) - integer :: i_next - - if (count_particles==number_per_bin .and. j /= energy_verified_no) then - i_next = iorder(array_particle_j(j+1)) - call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos_next,vel_next,i_next,pos_mag_next,vel_mag_next) +subroutine radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy_verified_no,pos_npart,radius_star,pos_vec_npart,rad_cyl) + integer,intent(in) :: count_particles,number_per_bin,i,energy_verified_no,bound_index(:) + real,intent(in) :: pos_npart(:),pos_vec_npart(:,:) + real,intent(out) :: radius_star,rad_cyl + + real :: pos_mag_next,pos_mag + integer :: index_val_next,index_val + real :: pos_cyl,pos_cyl_next + real :: pos_cyl_vec(3),pos_cyl_vec_next(3) + + index_val = bound_index(i) + index_val_next = bound_index(i+1) + pos_mag = pos_npart(index_val) + pos_cyl_vec(:) = pos_vec_npart(:,index_val) + pos_cyl = sqrt(pos_cyl_vec(1)**2 + pos_cyl_vec(2)**2) + if (count_particles == number_per_bin .and. i /= energy_verified_no) then + pos_mag_next = pos_npart(index_val_next) + pos_cyl_vec_next(:) = pos_vec_npart(:,index_val_next) + radius_star = (pos_mag+pos_mag_next)/2 + pos_cyl_next = sqrt(pos_cyl_vec_next(1)**2 + pos_cyl_vec_next(2)**2) + rad_cyl = (pos_cyl + pos_cyl_next)/2 else radius_star = pos_mag + rad_cyl = pos_cyl endif +! print*,norm2(pos_cyl_vec),"mag of pos_cyl vector",pos_mag,"pos_mag" end subroutine radius_of_remnant !---------------------------------------------------------------- !+ -! This subroutine calculates the moment of inertia +! This subroutine calculates the moment of inertia of each particle !+ !---------------------------------------------------------------- subroutine moment_of_inertia(pos,pos_mag,pmass,i_matrix) @@ -597,7 +772,107 @@ subroutine moment_of_inertia(pos,pos_mag,pmass,i_matrix) i_matrix = pmass*(pos_mag**2*delta - result_matrix) end subroutine moment_of_inertia - + !---------------------------------------------------------------- + !+ + ! This subroutine calculates the temperature of all particles + ! by sorting them out with radius + ! Density is also sorted and saved. Along with the radius + !+ + !---------------------------------------------------------------- + subroutine calculate_npart_quantities(npart,iorder,numfile,xyzh,vxyzu,pmass,xpos,vpos,comp_label,& + interpolate_comp,columns_compo,temp_npart,den_npart,pos_npart,vel_npart,& + pos_vec_npart,vel_vec_npart,tot_eng_npart,sorted_index_npart,ke_npart,pe_npart,& + pos_wrt_bh,vel_wrt_bh,h_npart,interp_comp_npart) + + use units , only : udist,umass,unit_velocity,unit_energ + use vectorutils, only : cross_product3D + use part, only : rhoh,poten + use sortutils, only : set_r2func_origin,indexxfunc,r2func_origin + use eos, only : equationofstate,entropy,X_in,Z_in,gmw,init_eos + use physcon, only : gg + + integer,intent(in) :: npart,iorder(:),numfile + real,intent(in) :: xyzh(:,:),vxyzu(:,:) + real,intent(in) :: pmass + real,intent(inout) :: xpos(:),vpos(:) + character(len=20),intent(in) :: comp_label(:) + real,intent(in) :: interpolate_comp(:,:) + integer,intent(in) :: columns_compo + real,allocatable,intent(out) :: temp_npart(:),den_npart(:),pos_npart(:),vel_npart(:),pos_wrt_bh(:,:),vel_wrt_bh(:,:),h_npart(:) + real,allocatable,intent(out) :: pos_vec_npart(:,:),vel_vec_npart(:,:),tot_eng_npart(:) + real,allocatable,intent(out) :: ke_npart(:),pe_npart(:),interp_comp_npart(:,:) + integer,allocatable,intent(out) :: sorted_index_npart(:) + + integer :: i,j,ierr,ieos + real :: pos(3),vel(3) + real :: potential_i, kinetic_i,energy_i,pos_mag,vel_mag + real :: density_i,temperature_i,eni_input,u_i + real :: ponrhoi,spsoundi,mu + real,allocatable :: composition_i(:) + real,allocatable :: A_array(:), Z_array(:) + + ieos = 2 + gmw = 0.61 + call init_eos(ieos,ierr) + allocate(composition_i(columns_compo)) + call assign_atomic_mass_and_number(comp_label,A_array,Z_array) + ! Allocate arrays to save the sorted index,density,temperature,radius,total energy of particle wrt centre, velocity_npart + allocate(temp_npart(npart),den_npart(npart),pos_npart(npart),vel_npart(npart),sorted_index_npart(npart),tot_eng_npart(npart),ke_npart(npart),pe_npart(npart)) + allocate(pos_vec_npart(3,npart),vel_vec_npart(3,npart),pos_wrt_bh(3,npart),vel_wrt_bh(3,npart),h_npart(npart),interp_comp_npart(columns_compo,npart)) + + do j = 1, npart + !Access the rank of each particle in radius and save the sorted index + i = iorder(j) + sorted_index_npart(j) = i + + !if (columns_compo /= 0) then + ! composition_i(:) = interpolate_comp(:,i) + !endif + + !the position of the particle is calculated by subtracting the point of + !highest density. + !xyzh is position wrt the black hole present at origin. + call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos,vel,i,pos_mag,vel_mag) + !calculate the position which is the location of the particle. + potential_i = poten(i) + kinetic_i = 0.5*pmass*vel_mag**2 + density_i = rhoh(xyzh(4,i),pmass) + energy_i = potential_i + kinetic_i + vxyzu(4,i)*pmass + print*,potential_i,"POTENTIAL I",kinetic_i,"Kinetic I" + + ! composition + if (columns_compo /= 0) then + composition_i(:) = interpolate_comp(:,i) + endif + if (i == 13) then + print*,composition_i(:),"compo",i,"i before",j,"j" + endif + ! calculate mean molecular weight that is required by the eos module using + ! the mass fractions for each particle. + ! do not consider neutron which is the first element of the composition_i array. + call calculate_mu(A_array,Z_array,composition_i,columns_compo,mu) + gmw = 1./mu + u_i = vxyzu(4,i) + eni_input = u_i + call equationofstate(ieos,ponrhoi,spsoundi,density_i,xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi=temperature_i,eni=eni_input) + ! Save the information for each particle that we need + den_npart(j) = density_i + temp_npart(j) = temperature_i + pos_npart(j) = pos_mag + vel_npart(j) = vel_mag + vel_vec_npart(:,j) = vel(:) + pos_vec_npart(:,j) = pos(:) + tot_eng_npart(j) = energy_i + ke_npart(j) = kinetic_i + pe_npart(j) = potential_i + pos_wrt_bh(:,j) = xyzh(1:3,i) + vel_wrt_bh(:,j) = vxyzu(1:3,i) + h_npart(j) = xyzh(4,i) + + interp_comp_npart(:,j) = interpolate_comp(:,i) + enddo + + end subroutine calculate_npart_quantities !---------------------------------------------------------------- !+ ! This routine reads the output file that contains composition @@ -624,7 +899,7 @@ subroutine composition_array(interpolate_comp,columns_compo,comp_label) n_rows = 0 iexist = .false. - filename = 'kepler.comp' + filename = 'tde.comp' !First check if kepler.comp exists. !This file will only be generated if KEPLER file had composition stored in it. inquire(file=filename,exist=iexist) @@ -641,16 +916,16 @@ subroutine composition_array(interpolate_comp,columns_compo,comp_label) !Save composition read from file. allocate(interpolate_comp(columns_compo,n_rows)) - open(12,file=filename) + open(12, file=filename) ierr = 0 !get column labels and send them back. - read(12, '(a)',iostat=ierr) line + read(12, '(a)', iostat=ierr) line allocate(comp_label(columns_compo)) call get_column_labels(line,n_labels,comp_label) close(12) print*,"comp_label ",comp_label - open(13,file=filename) + open(13, file=filename) call skip_header(13,nheader,ierr) do k = 1, n_rows read(13,*,iostat=ierr) interpolate_comp(:,k) @@ -673,7 +948,7 @@ subroutine assign_atomic_mass_and_number(comp_label,A_array,Z_array) real,allocatable :: A_array(:), Z_array(:) integer :: size_to_allocate, i - if ( any( comp_label=="nt1" ) ) then + if ( ANY( comp_label=="nt1" ) ) then size_to_allocate = size(comp_label(:))-1 else @@ -795,7 +1070,12 @@ subroutine calculate_mu(A_array,Z_array,composition_i,columns_compo,mu) end subroutine calculate_mu - +!---------------------------------------------------------------- +!+ +! This routine updates the dump_info file with the information +! for full dumps files +!+ +!---------------------------------------------------------------- subroutine write_dump_info(fileno,density,temperature,mass,xpos,rad,distance,pos_mag_star,vel_mag_star,& tot_energy,kinetic_energy,potential_energy,time,vel_at_infinity) @@ -814,20 +1094,20 @@ subroutine write_dump_info(fileno,density,temperature,mass,xpos,rad,distance,pos ! open the file for appending or creating if (file_exists) then - open(unit=file_id,file=filename,status='old', position="append",action="write",iostat=status) - if (status /= 0) then - write(*,*) 'Error opening file: ', filename - stop - endif + open(unit=file_id, file=filename, status='old', position="append", action="write", iostat=status) + if (status /= 0) then + write(*,*) 'Error opening file: ', filename + stop + endif - else - open(unit=file_id,file=filename,status='new',action='write',iostat=status) - if (status /= 0) then - write(*,*) 'Error creating file: ', filename - stop - endif - ! Write headers to file - write(file_id,'(16(a22,1x))') & +else + open(unit=file_id, file=filename, status='new', action='write', iostat=status) + if (status /= 0) then + write(*,*) 'Error creating file: ', filename + stop + endif + ! Write headers to file + write(file_id,'(17(a22,1x))') & "FileNo", & "Density",& "Temperature",& @@ -843,11 +1123,12 @@ subroutine write_dump_info(fileno,density,temperature,mass,xpos,rad,distance,pos "specKE",& "specPE",& "time",& - "Escape_in" - endif - write(file_id,'(i5,1x,15(e18.10,1x))')fileno,density*unit_density,temperature,mass*umass,xpos(1)*udist,xpos(2)*udist,xpos(3)*udist,rad*udist,distance*udist,pos_mag_star*udist,& - vel_mag_star*unit_velocity,tot_energy,kinetic_energy,potential_energy,time*utime,vel_at_infinity*1e-5 - close(file_id) + "Escape_in",& + "Accretion_r" +endif +write(file_id,'(i5,1x,16(e18.10,1x))')fileno,density*unit_density,temperature,mass*umass,xpos(1)*udist,xpos(2)*udist,xpos(3)*udist,rad*udist,distance*udist,pos_mag_star*udist,& + vel_mag_star*unit_velocity,tot_energy,kinetic_energy,potential_energy,time*utime,vel_at_infinity*1e-5,(mass*umass)/(time/(365*24*3600)*utime) +close(file_id) end subroutine write_dump_info @@ -859,43 +1140,178 @@ end subroutine write_dump_info !+ !---------------------------------------------------------------- subroutine write_compo_wrt_bh(xyzh,vxyzu,xpos,vpos,pmass,npart,iorder,array_bh_j,interpolate_comp,columns_compo,comp_label,energy_verified_no,last_particle_with_neg_e) - use units , only: udist - - real,intent(in) :: xyzh(:,:),vxyzu(:,:) - real,intent(in) :: xpos(3),vpos(3),pmass - integer,intent(in) :: npart,iorder(:),columns_compo - integer,allocatable,intent(in) :: array_bh_j(:) - integer,intent(in) :: energy_verified_no,last_particle_with_neg_e - character(len=20),intent(in) :: comp_label(:) - real,intent(in) :: interpolate_comp(:,:) - - integer,allocatable :: array_particle_j(:) - real,allocatable :: composition_i(:) - integer :: i,j - real :: pos_to_bh - character(len=120) :: output - - !call particles_bound_to_star(xpos,vpos,xyzh,vxyzu,pmass,npart,iorder,energy_verified_no,last_particle_with_neg_e,array_particle_j,array_bh_j) - !call composition_array(interpolate_comp,columns_compo,comp_label) - write(output,"(a8)") 'compo_bh' - open(4,file=output) - write(4,"(19(a22,1x))") & + use units , only: udist + + real,intent(in) :: xyzh(:,:),vxyzu(:,:) + real,intent(in) :: xpos(3),vpos(3),pmass + integer,intent(in) :: npart,iorder(:),columns_compo + integer,allocatable,intent(in) :: array_bh_j(:) + integer,intent(in) :: energy_verified_no,last_particle_with_neg_e + character(len=20),intent(in) :: comp_label(:) + real,intent(in) :: interpolate_comp(:,:) + + integer,allocatable :: array_particle_j(:) + real,allocatable :: composition_i(:) + integer :: i,j + real :: pos_to_bh + character(len=120) :: output + + !call particles_bound_to_star(xpos,vpos,xyzh,vxyzu,pmass,npart,iorder,energy_verified_no,last_particle_with_neg_e,array_particle_j,array_bh_j) + !call composition_array(interpolate_comp,columns_compo,comp_label) + write(output,"(a8)") 'compo_bh' + open(4,file=output) + write(4,"(19(a22,1x))") & "posToBH", & comp_label - allocate(composition_i(columns_compo)) - do j = 1, size(array_bh_j) - i = iorder(j) !Access the rank of each particle in radius. - pos_to_bh = sqrt(dot_product(xyzh(1:3,i),xyzh(1:3,i))) - if (columns_compo /= 0) then + allocate(composition_i(columns_compo)) + do j = 1, size(array_bh_j) + i = iorder(j) !Access the rank of each particle in radius. + pos_to_bh = sqrt(dot_product(xyzh(1:3,i),xyzh(1:3,i))) + if (columns_compo /= 0) then composition_i(:) = interpolate_comp(:,i) - endif - write(4,'(19(e18.10,1x))') & + endif + write(4,'(19(e18.10,1x))') & pos_to_bh*udist,& composition_i(:) - enddo - close(4) + enddo + close(4) end subroutine write_compo_wrt_bh + !---------------------------------------------------------------- + !+ + ! This subroutine is to get the temperature cut + ! + !+ + !---------------------------------------------------------------- +subroutine calculate_temp_cut(temperature_array,count_bound,temp_cut,max_temp,temp_found,count_loops_temp,density_array) + real,intent(in) :: temperature_array(:),max_temp,density_array(:) + integer,intent(in) :: count_bound,count_loops_temp + real,intent(out) :: temp_cut + integer :: i,count_possible_temp,m + integer,parameter :: nbins=20000 + real, dimension(nbins)::temp_array_test + real,allocatable :: avg_density(:) + real,allocatable :: temp_array_new(:),count_particles_temp(:),diff_count_particles(:),diff2_count_particles(:),diff3_count_particles(:),array_input(:) + real :: temp_start,count_temp_particles=0,dtemp + integer :: index_val,avg_inde + real :: mean,variance,std,cut_off + real :: count_cut,count_cut_index,lower_limit,upper_limit + logical, intent(inout) :: temp_found + + + ! First we create an array of possible temperature from max_temp to 0 with a step size of 100. + temp_start = 0. + dtemp = 100. + + count_cut_index = 0 + count_cut = 0. + count_possible_temp=1+(max_temp/dtemp) + + ! Create array with the temperatures ranging from 0 to max_temp + do m=1,nbins + if (temp_start <= max_temp) then + temp_array_test(m) = temp_start + temp_start = temp_start + dtemp + endif + end do + + ! Allocate arrays to save the number of particles per bin + allocate(temp_array_new(count_possible_temp),count_particles_temp(count_possible_temp), array_input(count_possible_temp),avg_density(count_possible_temp)) + + count_particles_temp(:) = 0 + + ! Next we create the same size array as count_possible_temp + do m=1,count_possible_temp + temp_array_new(m) = temp_array_test(m) + enddo + + ! this will count the particles for each temperature and then save them into a new array + do i =1,count_bound + do m=1,size(temp_array_new)-1 + if (temperature_array(i) >= temp_array_new(m) .and. temperature_array(i) < temp_array_new(m+1) ) then + count_temp_particles = count_particles_temp(m) + 1 + count_particles_temp(m) = count_temp_particles + avg_density(m) = density_array(i) + endif + enddo + enddo + + print*,"***-------------------------------------" + print*,temp_array_new,"TEMP ARRAY",size(temp_array_new) + print*,count_particles_temp,"COUNT PARTICLES TEMP",size(count_particles_temp) + print*,avg_density,"AVG DENSITY FOR EACH BIN" + print*,"***-------------------------------------" + ! Calculate the mean, std of the data + call statistics(count_particles_temp,mean,variance,std) + + ! Using 2 sigma as the data sample is small to determine the outlier + cut_off = std*2 + lower_limit = mean - cut_off + upper_limit = mean + cut_off + + + ! This loops and find the last element which is outside the limits based on 2 sigma + do i=1,size(count_particles_temp) + if (count_particles_temp(i) > upper_limit .or. count_particles_temp(i) < lower_limit) then + count_cut = count_particles_temp(i) + count_cut_index = i + endif + enddo + print*,count_cut,"count cut first",count_cut_index,"count_cut_index" + ! this starts from the cound_cut_index found earlier but then tries to make sure that the cut is done when the gaussian bins + ! have less than 5% particles compared to the max_temp_cut found above + do i=count_cut_index,size(count_particles_temp) + if ((count_particles_temp(i)/count_cut)*100 < 1.) then + count_cut = count_particles_temp(i) + print*,count_cut,"count_cut",(count_particles_temp(i)/count_cut)*100,"(count_particles_temp(i)/count_cut)*100" + count_cut_index = i + exit + endif + enddo + + !print*,count_cut_index,"final cut index" + + ! Define the temperature to cut the model at + temp_cut = temp_array_new(count_cut_index) + + if (temp_cut .ne. max_temp) then + temp_found = .true. + endif + + ! If we get the temp_cut as 0. K and the count_loops_temp is 1, then we accept that as a true value + if (temp_cut .eq. 0.0 .and. count_loops_temp /= 1) then + temp_found = .false. + endif + print*,temp_cut,"TEMP CUT" +end subroutine calculate_temp_cut + +! -------------------------------------------------------------------- +! This subroutine calculates the mean, variance and standard deviation +! +! -------------------------------------------------------------------- +subroutine statistics(array_data,mean,variance,std) + real,allocatable,intent(in) :: array_data(:) + real,intent(out) :: mean,variance + integer :: size_array,i + real :: var,sum_val,std + + sum_val = 0. + var = 0. + size_array = size(array_data) + do i=1,size_array + sum_val = sum_val + array_data(i) + enddo + mean = sum_val/size_array + + do i=1,size_array + var = var + (array_data(i) - mean)**2 + enddo + + variance = var/(size_array-1) + std = sqrt(variance) + +end subroutine statistics + end module analysis From 4de69f4cb2f963f4d3632ec1c72760138b5302ce Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 11:30:53 +1100 Subject: [PATCH 19/54] (gr_sink) missing endif added --- src/main/initial.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 1d7e2ba7c..82046c389 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -536,6 +536,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& iexternalforce,time,merge_ij,merge_n,dsdt_ptmass,& group_info,bin_info) + endif #ifdef GR ! calculate metric derivatives and the external force caused by the metric on the sink particles ! this will also return the timestep for sink-sink From e1d61db20b9c341de3248b3d2278003d84169708 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 6 Dec 2024 12:39:51 +1100 Subject: [PATCH 20/54] (gr_sink) error in the indexing of force arrays fixed --- src/tests/test_ptmass.f90 | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 71d9ab2c6..25e6f7ad9 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -317,7 +317,7 @@ subroutine test_binary(ntests,npass,string) ! if (id==master) then call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,merge_ij,merge_n,dsdt_sinksink,ti=0.) + dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink) endif fxyz_ptmass(:,1:nptmass) = 0. dsdt_ptmass(:,1:nptmass) = 0. @@ -511,7 +511,7 @@ subroutine test_sink_binary_gr(ntests,npass,string) t = 0. ! chose a very small value because a value of 0.35 was resulting in distance - distance_init of 1.e-3 ! but using a small timestep resulted in values smaller than equal to 1.e-4 - C_force = 0.01 + C_force = 0.25 norbits = 2 tol = epsilon(0.) omega = sqrt((m1+m2)/a**3) @@ -537,7 +537,7 @@ subroutine test_sink_binary_gr(ntests,npass,string) vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,dens=dens_ptmass,use_sink=.true.) ! sinks in GR, provide external force due to metric to determine the sink total force call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,merge_ij,merge_n,dsdt_sinksink,ti=0.) + dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fxyz_sinksink,fxyz_ptmass) @@ -545,11 +545,11 @@ subroutine test_sink_binary_gr(ntests,npass,string) ! Test the force calculated is same as sink-sink because there is no curvature. call checkval(fxyz_sinksink(1,1), fxyz_ptmass(1,1),tol,nfailed(1),'x force term for sink 1') - call checkval(fxyz_sinksink(1,2), fxyz_ptmass(1,2),tol,nfailed(2),'y force term for sink 1') - call checkval(fxyz_sinksink(1,3), fxyz_ptmass(1,3),tol,nfailed(3),'z force term for sink 1') - call checkval(fxyz_sinksink(2,1), fxyz_ptmass(2,1),tol,nfailed(4),'x force term for sink 2') + call checkval(fxyz_sinksink(2,1), fxyz_ptmass(2,1),tol,nfailed(2),'y force term for sink 1') + call checkval(fxyz_sinksink(3,1), fxyz_ptmass(3,1),tol,nfailed(3),'z force term for sink 1') + call checkval(fxyz_sinksink(1,2), fxyz_ptmass(1,2),tol,nfailed(4),'x force term for sink 2') call checkval(fxyz_sinksink(2,2), fxyz_ptmass(2,2),tol,nfailed(5),'y force term for sink 2') - call checkval(fxyz_sinksink(2,3), fxyz_ptmass(2,3),tol,nfailed(6),'z force term for sink 2') + call checkval(fxyz_sinksink(3,2), fxyz_ptmass(3,2),tol,nfailed(6),'z force term for sink 2') call update_test_scores(ntests,nfailed(1:3),npass) call update_test_scores(ntests,nfailed(3:6),npass) @@ -680,7 +680,7 @@ subroutine test_softening(ntests,npass) vxyz_ptmass(2,2) = -v_c2 vxyz_ptmass(3,2) = 0. call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,& - dtsinksink,0,merge_ij,merge_n,dsdt_ptmass,ti=0.) + dtsinksink,0,0.,merge_ij,merge_n,dsdt_ptmass) call compute_energies(t) etotin = etot totmomin = totmom @@ -773,7 +773,7 @@ subroutine test_chinese_coin(ntests,npass,string) iverbose = 1 call update_externalforce(iexternalforce,t,0.) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,& - dtext,iexternalforce,merge_ij,merge_n,dsdt_ptmass,ti=t) + dtext,iexternalforce,t,merge_ij,merge_n,dsdt_ptmass) dtext = 1.e-15 ! take small first step norbit = 0 @@ -1256,7 +1256,7 @@ subroutine test_merger(ntests,npass) ! if (id==master) then call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,merge_ij,merge_n,dsdt_ptmass,ti=0.) + dtsinksink,0,0.,merge_ij,merge_n,dsdt_ptmass) endif fxyz_ptmass(:,:) = 0. call bcast_mpi(epot_sinksink) @@ -1576,8 +1576,8 @@ subroutine test_SDAR(ntests,npass) call group_identify(nptmass,n_group,n_ingroup,n_sing,xyzmh_ptmass,vxyz_ptmass,& group_info,bin_info,nmatrix) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& - dtsinksink,0,merge_ij,merge_n,dsdt_sinksink,& - group_info=group_info,bin_info=bin_info,ti=0.) + dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink,& + group_info=group_info,bin_info=bin_info) endif fxyz_ptmass(:,1:nptmass) = 0. dsdt_ptmass(:,1:nptmass) = 0. From f954d1710e53364ecfdcc144824fd4217ee00b94 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:00:36 +1100 Subject: [PATCH 21/54] (gr_sink) dens_ptmass is no longer needed --- src/main/cons2prim.f90 | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/src/main/cons2prim.f90 b/src/main/cons2prim.f90 index 709f68cd6..ad80dcad8 100644 --- a/src/main/cons2prim.f90 +++ b/src/main/cons2prim.f90 @@ -53,8 +53,8 @@ subroutine prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens,dens,use_sink) real, intent(inout), optional :: dens(:) logical, intent(in), optional :: use_dens, use_sink logical :: usedens - integer :: i,loop_no - real :: pri,tempi,xyzhi(4),vxyzui(4) + integer :: i + real :: pri,tempi,xyzhi(4),vxyzui(4),densi ! By default, use the smoothing length to compute primitive density, and then compute the conserved variables. ! (Alternatively, use the provided primitive density to compute conserved variables. @@ -67,7 +67,7 @@ subroutine prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens,dens,use_sink) !$omp parallel do default (none) & !$omp shared(xyzh,metrics,vxyzu,dens,pxyzu,npart,usedens,ien_type,eos_vars,gamma,ieos,use_sink,use_dens) & - !$omp private(i,pri,tempi,xyzhi,vxyzui) + !$omp private(i,pri,tempi,xyzhi,vxyzui,densi) do i=1,npart if (present(use_sink)) then @@ -75,8 +75,9 @@ subroutine prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens,dens,use_sink) xyzhi(4) = xyzh(5,i) ! save smoothing length, h vxyzui(1:3) = vxyzu(1:3,i) vxyzui(4) = 0. ! assume energy as 0. for sink + densi = 1. call prim2consi(xyzhi,metrics(:,:,:,i),vxyzui,pri,tempi,pxyzu(:,i),ien_type,& - use_sink=use_sink,dens_i=dens(i)) ! this returns temperature and pressure as 0. + use_sink=use_sink,dens_i=densi) ! this returns temperature and pressure as 0. else if (.not.isdead_or_accreted(xyzh(4,i))) then call prim2consi(xyzh(:,i),metrics(:,:,:,i),vxyzu(:,i),pri,tempi,pxyzu(:,i),ien_type,& @@ -117,7 +118,8 @@ subroutine prim2consi(xyzhi,metrici,vxyzui,pri,tempi,pxyzui,ien_type,use_dens,us real, intent(inout), optional :: dens_i logical :: usedens real :: rhoi,ui,xyzi(1:3),vi(1:3),pondensi,spsoundi,densi - + + pondensi = 0. ! By default, use the smoothing length to compute primitive density, and then compute the conserved variables. ! (Alternatively, use the provided primitive density to compute conserved variables. ! Depends whether you have prim dens prior or not.) @@ -136,7 +138,6 @@ subroutine prim2consi(xyzhi,metrici,vxyzui,pri,tempi,pxyzui,ien_type,use_dens,us else if (present(use_sink)) then densi = 1. ! using a value of 0. results in NaN values for the pxyzui array. - dens_i = densi ! we do not call EOS for sinks. pondensi = 0. else call h2dens(densi,xyzhi,metrici,vi) ! Compute dens from h @@ -217,7 +218,7 @@ end subroutine cons2primall ! from the evolved/conservative variables (rho*,momentum,entropy) !+ !---------------------------------------------------------------------- -subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) +subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,eos_vars) use cons2primsolver, only:conservative2primitive use part, only:isdead_or_accreted,massoftype,igas,rhoh,igasP,ics,ien_type,& itemp,igamma @@ -225,24 +226,25 @@ subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) use eos, only:ieos,done_init_eos,init_eos,get_spsound integer, intent(in) :: npart real, intent(in) :: pxyzu(:,:),xyzh(:,:),metrics(:,:,:,:) - real, intent(inout) :: vxyzu(:,:),dens(:) + real, intent(inout) :: vxyzu(:,:) real, intent(out), optional :: eos_vars(:,:) integer :: i, ierr - real :: p_guess,rhoi,tempi,gammai,eni + real :: p_guess,rhoi,tempi,gammai,eni,densi if (.not.done_init_eos) call init_eos(ieos,ierr) !$omp parallel do default (none) & -!$omp shared(xyzh,metrics,vxyzu,dens,pxyzu,npart,massoftype) & +!$omp shared(xyzh,metrics,vxyzu,pxyzu,npart,massoftype) & !$omp shared(ieos,eos_vars,ien_type) & -!$omp private(i,ierr,p_guess,rhoi,tempi,gammai,eni) +!$omp private(i,ierr,p_guess,rhoi,tempi,gammai,eni,densi) do i=1,npart p_guess = 0. tempi = 0. gammai = 0. rhoi = 1. + densi = 1. ! conservative 2 primitive - call conservative2primitive(xyzh(1:3,i),metrics(:,:,:,i),vxyzu(1:3,i),dens(i),eni, & + call conservative2primitive(xyzh(1:3,i),metrics(:,:,:,i),vxyzu(1:3,i),densi,eni, & p_guess,tempi,gammai,rhoi,pxyzu(1:3,i),pxyzu(4,i),ierr,ien_type) if (ierr > 0) then From 1113dbf7865bf6868d1c53536318735513341bea Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:01:12 +1100 Subject: [PATCH 22/54] (gr_sink) dens is a optional arguement in get_grforce_all --- src/main/extern_gr.f90 | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/main/extern_gr.f90 b/src/main/extern_gr.f90 index 687c30768..8ab382709 100644 --- a/src/main/extern_gr.f90 +++ b/src/main/extern_gr.f90 @@ -58,24 +58,25 @@ end subroutine get_grforce ! gradients on all particles !+ !--------------------------------------------------------------- -subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtexternal,use_sink) +subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtexternal,use_sink,dens) use timestep, only:C_force use eos, only:ieos,get_pressure use part, only:isdead_or_accreted integer, intent(in) :: npart - real, intent(in) :: xyzh(:,:), metrics(:,:,:,:), metricderivs(:,:,:,:), dens(:) + real, intent(in) :: xyzh(:,:), metrics(:,:,:,:), metricderivs(:,:,:,:) real, intent(inout) :: vxyzu(:,:) real, intent(out) :: fext(:,:), dtexternal + real, intent(in), optional :: dens(:) logical, intent(in), optional :: use_sink ! we pick the data from the xyzh array and assume u=0 for this case integer :: i - real :: dtf,pi + real :: dtf,pi,densi real :: xyzhi(4),vxyzui(4) dtexternal = huge(dtexternal) !$omp parallel do default(none) & !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,ieos,C_force,use_sink) & - !$omp private(i,dtf,pi,xyzhi,vxyzui) & + !$omp private(i,dtf,pi,xyzhi,vxyzui,densi) & !$omp reduction(min:dtexternal) do i=1,npart if (present(use_sink)) then @@ -85,7 +86,8 @@ subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtext vxyzui(1:3) = vxyzu(1:3,i) vxyzui(4) = 0. pi = 0. - call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzui(1:3),dens(i),vxyzui(4),pi,fext(1:3,i),dtf) + densi = 1. + call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzui(1:3),densi,vxyzui(4),pi,fext(1:3,i),dtf) dtexternal = min(dtexternal,C_force*dtf) else From d580730f2061a0b66a18987235d5d80ad5444909 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:01:52 +1100 Subject: [PATCH 23/54] (gr_aink) dens_ptmass no longer exists --- src/main/initial.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 82046c389..66d31ea4f 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -143,7 +143,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) nden_nimhd,dustevol,rhoh,gradh,apr_level,aprmassoftype,& Bevol,Bxyz,dustprop,filfac,ddustprop,ndustsmall,iboundary,eos_vars,dvdx, & n_group,n_ingroup,n_sing,nmatrix,group_info,bin_info,isionised - use part, only:pxyzu,dens,metrics,rad,radprop,drad,ithick,metrics_ptmass,pxyzu_ptmass,dens_ptmass,& + use part, only:pxyzu,dens,metrics,rad,radprop,drad,ithick,metrics_ptmass,pxyzu_ptmass,& fext_ptmass use densityforce, only:densityiterate use linklist, only:set_linklist @@ -464,7 +464,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) if (iexternalforce > 0 .and. imetric /= imet_minkowski) then call initialise_externalforces(iexternalforce,ierr) if (ierr /= 0) call fatal('initial','error in external force settings/initialisation') - call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtextforce) + call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) endif #else if (iexternalforce > 0) then @@ -542,12 +542,12 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) ! this will also return the timestep for sink-sink call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& - vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,dens=dens_ptmass,use_sink=.true.) + vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) ! sinks in GR, provide external force due to metric to determine the sink total force call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& iexternalforce,time,merge_ij,merge_n,dsdt_ptmass) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& - vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) + vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) #endif dtsinksink = C_force*dtsinksink From 2552a1c101b25edcc186d95a26202f7197958218 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:02:18 +1100 Subject: [PATCH 24/54] (gr_sink) no allocatable dens_ptmass array --- src/main/part.F90 | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/main/part.F90 b/src/main/part.F90 index 6d4b8e414..934bf192e 100644 --- a/src/main/part.F90 +++ b/src/main/part.F90 @@ -191,7 +191,6 @@ module part !--sink particles in General relativity ! real, allocatable :: pxyzu_ptmass(:,:) !pxyz_ptmass(maxvxyzu,maxgr) - real, allocatable :: dens_ptmass(:) real, allocatable :: metrics_ptmass(:,:,:,:) !metrics(0:3,0:3,2,maxgr) real, allocatable :: metricderivs_ptmass(:,:,:,:) !metricderivs(0:3,0:3,3,maxgr) real, allocatable :: fext_ptmass(:,:) @@ -483,7 +482,6 @@ subroutine allocate_part call allocate_array('tmunus', tmunus, 4, 4, maxgr) call allocate_array('sqrtgs', sqrtgs, maxgr) call allocate_array('pxyzu_ptmass', pxyzu_ptmass, maxvxyzu, maxptmassgr) - call allocate_array('dens_ptmass', dens_ptmass, maxptmassgr) call allocate_array('metrics_ptmass', metrics_ptmass, 4, 4, 2, maxptmassgr) call allocate_array('metricderivs_ptmass', metricderivs_ptmass, 4, 4, 3, maxptmassgr) call allocate_array('fext_ptmass', fext_ptmass, 4, maxptmassgr) @@ -582,7 +580,6 @@ subroutine deallocate_part if (allocated(tmunus)) deallocate(tmunus) if (allocated(sqrtgs)) deallocate(sqrtgs) if (allocated(pxyzu_ptmass)) deallocate(pxyzu_ptmass) - if (allocated(dens_ptmass)) deallocate(dens_ptmass) if (allocated(metrics_ptmass)) deallocate(metrics_ptmass) if (allocated(metricderivs_ptmass)) deallocate(metricderivs_ptmass) if (allocated(fext_ptmass)) deallocate(fext_ptmass) From f04ebb6b8d48dea6c115fc63ab80dfe1b546cbdc Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:03:17 +1100 Subject: [PATCH 25/54] (gr_sink) dens is optional argument in get_grforce_all, fixed the call to it --- src/main/partinject.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/partinject.F90 b/src/main/partinject.F90 index b41b64fe9..8143981fe 100644 --- a/src/main/partinject.F90 +++ b/src/main/partinject.F90 @@ -168,7 +168,7 @@ end subroutine add_or_update_sink subroutine update_injected_particles(npartold,npart,istepfrac,nbinmax,time,dtmax,dt,dtinject) use dim, only:ind_timesteps use timestep_ind, only:get_newbin,change_nbinmax,get_dt - use part, only:twas,ibin,ibin_old,iphase,igas,iunknown,nptmass + use part, only:twas,ibin,ibin_old,iphase,igas,iunknown #ifdef GR use part, only:xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext use cons2prim, only:prim2consall @@ -198,7 +198,7 @@ subroutine update_injected_particles(npartold,npart,istepfrac,nbinmax,time,dtmax call init_metric(npart,xyzh,metrics,metricderivs) call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) if (iexternalforce > 0 .and. imetric /= imet_minkowski) then - call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtext_dum) ! Not 100% sure if this is needed here + call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtext_dum,dens=dens) ! Not 100% sure if this is needed here endif #endif From d23651f3efd60af722c29da2bc673f606f356235 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:04:03 +1100 Subject: [PATCH 26/54] (gr sink) can step on sink-gas particles in GR now --- src/main/substepping.F90 | 346 ++++++++++++++++++++++----------------- 1 file changed, 198 insertions(+), 148 deletions(-) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index bdc142678..82779949c 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -110,14 +110,12 @@ subroutine substep_sph_gr(dt,npart,xyzh,vxyzu,dens,pxyzu,metrics) end subroutine substep_sph_gr -subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time,use_sink) +subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time,& + xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) use dim, only:maxptmass,maxvxyzu,use_apr use io, only:iverbose,id,master,iprint,warning,fatal - use externalforces, only:externalforce,accrete_particles,update_externalforce - use options, only:iexternalforce - use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& - massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& - aprmassoftype,apr_level + use part, only:isdead_or_accreted,iamboundary,igas,iamtype,& + massoftype,rhoh,igamma,itemp,igasP use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber use eos, only:equationofstate @@ -125,16 +123,16 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric use extern_gr, only:get_grforce use metric_tools, only:pack_metric,pack_metricderivs use damping, only:calc_damp,apply_damp - integer, intent(in) :: npart,ntypes + integer, intent(in) :: npart,ntypes,nptmass real, intent(in) :: dtsph,time real, intent(inout) :: dtextforce real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - logical, intent(in), optional :: use_sink - integer :: itype,nsubsteps,naccreted,nlive + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:) + real, intent(inout) :: pxyzu_ptmass(:,:),metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:) + + integer :: itype,nsubsteps,naccreted,nlive,nlive_sinks,naccreted_sinks real :: timei,t_end_step,hdt,pmassi real :: dt,dtextforcenew,dtextforce_min - real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) - !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) real :: accretedmass,damp_fac ! real, save :: dmdt = 0. logical :: last_step,done @@ -165,6 +163,7 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric nsubsteps = 0 dtextforce_min = huge(dt) done = .false. + substeps: do while (timei <= t_end_step .and. .not.done) hdt = 0.5*dt timei = timei + dt @@ -177,15 +176,12 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric write(iprint,"(a,f14.6)") '> external forces only : t=',timei endif - if (present(use_sink)) then - call predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & - dens,metrics,metricderivs,pitsmax,perrmax, & - xitsmax,xerrmax,dtextforcenew) - else - call predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & - dens,metrics,metricderivs,pitsmax,perrmax, & - xitsmax,xerrmax,dtextforcenew) - endif + + call predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & + dens,metrics,metricderivs,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& + metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,pitsmax,perrmax, & + xitsmax,xerrmax,dtextforcenew) + if (iverbose >= 2 .and. id==master) then write(iprint,*) '------ Iterations summary: -------------------------------' @@ -202,15 +198,11 @@ subroutine substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metric nlive = 0 dtextforce_min = bignumber - if (present(use_sink)) then - call accrete_gr_sink(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& - pxyzu,accretedmass,hdt,npart, & - ntypes,dtextforce_min,timei) - else - call accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& - pxyzu,accretedmass,hdt,npart, & - ntypes,dtextforce_min,timei) - endif + call accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& + pxyzu,accretedmass,hdt,npart,nptmass,& + ntypes,dtextforce_min,timei,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& + metrics_ptmass,metricderivs_ptmass,& + pxyzu_ptmass,nlive_sinks,naccreted_sinks) if (npart > 2 .and. nlive < 2) then call fatal('step','all particles accreted',var='nlive',ival=nlive) @@ -1073,8 +1065,11 @@ end subroutine get_external_force_gas ! routine for prediction substep in GR case !+ !---------------------------------------------------------------- -subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & - dens,metrics,metricderivs,pitsmax,perrmax, & +subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & + dens,metrics,metricderivs,& + xyzh_ptmass,vxyz_ptmass,fxyz_ptmass,& + metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& + pitsmax,perrmax,& xitsmax,xerrmax,dtextforcenew) use dim, only:maxptmass,maxp,maxvxyzu,use_apr @@ -1082,7 +1077,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & use externalforces, only:externalforce,accrete_particles,update_externalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& - aprmassoftype,apr_level + aprmassoftype,apr_level,epot_sinksink use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,xtol,ptol use eos, only:equationofstate,ieos @@ -1090,12 +1085,17 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & use extern_gr, only:get_grforce use metric_tools, only:pack_metric,pack_metricderivs use damping, only:calc_damp,apply_damp + use options, only:iexternalforce + use ptmass, only:get_accel_sink_sink,get_accel_sink_gas + real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - real, intent(in) :: dt,hdt,dtextforcenew,timei - integer, intent(in) :: npart,ntypes + real, intent(inout) :: xyzh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:) + real, intent(in) :: dt,hdt,timei + integer, intent(in) :: npart,ntypes,nptmass integer, intent(inout) :: pitsmax,xitsmax - real, intent(inout) :: perrmax,xerrmax + real, intent(inout) :: perrmax,xerrmax,dtextforcenew integer :: i,its,ierr,itype integer, parameter :: itsmax = 50 @@ -1106,19 +1106,38 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & real :: x_err,pmom_err ! real, save :: dmdt = 0. logical :: converged - real :: rhoi,hi,eni,uui,densi - - !--------------------------- - ! predictor during substeps - !--------------------------- + real :: rhoi,hi,eni,uui,densi,poti + real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) + real :: dtphi2,dtsinksink,fonrmax + integer :: merge_ij(nptmass),merge_n + real :: fext_gas(4,npart),fext_sinks(4,nptmass) + + pmassi = massoftype(igas) + itype = igas + fext_gas = 0. + fext_sinks = 0. + + !---------------------------------------------- + ! calculate acceleration sink-sink + !---------------------------------------------- + call get_accel_sink_sink(nptmass,xyzh_ptmass,fext_sinks,epot_sinksink,dtsinksink,& + iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) + !---------------------------------------------- + ! predictor during substeps for gas particles + !---------------------------------------------- ! ! predictor step for external forces, also recompute external forces ! !$omp parallel do default(none) & !$omp shared(npart,xyzh,vxyzu,fext,iphase,ntypes,massoftype) & + !$omp shared(nptmass,xyzh_ptmass,vxyz_ptmass,fxyz_ptmass) & !$omp shared(maxphase,maxp,eos_vars) & + !$omp shared(bin_info,dtphi2,poti,fonrmax) & + !$omp shared(fext_gas,fext_sinks) & !$omp shared(dt,hdt,xtol,ptol,aprmassoftype,apr_level) & !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & + !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass) & + !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce) & !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi) & !$omp private(converged,pmom_err,x_err,pri,ierr,gammai) & !$omp firstprivate(pmassi,itype) & @@ -1128,7 +1147,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & xyz(1) = xyzh(1,i) xyz(2) = xyzh(2,i) xyz(3) = xyzh(3,i) - hi = xyzh(4,i) + hi = xyzh(4,i) if (.not.isdead_or_accreted(hi)) then if (ntypes > 1 .and. maxphase==maxp) then itype = iamtype(iphase(i)) @@ -1140,7 +1159,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & elseif (use_apr) then pmassi = aprmassoftype(igas,apr_level(i)) endif - + its = 0 converged = .false. ! @@ -1166,10 +1185,19 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & pmom_iterations: do while (its <= itsmax .and. .not. converged) its = its + 1 pprev = pxyz + ! calculate force between sink-gas particles + call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzh_ptmass, & + fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_sinks,& + dsdt_ptmass,fonrmax,dtphi2,bin_info) + + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + call combine_forces_gr_one(fext_gas(1:3,i),fstar(1:3)) + pxyz = pprev + hdt*(fstar - fexti) pmom_err = maxval(abs(pxyz - pprev)) if (pmom_err < ptol) converged = .true. @@ -1229,6 +1257,10 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & enddo predictor !$omp end parallel do + call predict_gr_sink(xyzh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fext_sinks,nptmass,& + dt,timei,hdt,metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax,& + xitsmax,xerrmax) + end subroutine predict_gr !---------------------------------------------------------------- @@ -1236,10 +1268,9 @@ end subroutine predict_gr ! routine for prediction substep in GR case !+ !---------------------------------------------------------------- -subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & - dens,metrics,metricderivs,pitsmax,perrmax, & - xitsmax,xerrmax,dtextforcenew ) - +subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fext_sinks,nptmass,dt,timei,hdt, & + metrics,metricderivs,dtextforcenew,pitsmax,perrmax, & + xitsmax,xerrmax) use dim, only:maxptmass,maxp,maxvxyzu use io, only:master,warning,fatal use externalforces, only:externalforce,accrete_particles,update_externalforce @@ -1256,17 +1287,17 @@ subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & use ptmass, only:get_accel_sink_sink use options, only:iexternalforce - real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:),dtextforcenew - real, intent(in) :: dt,hdt,timei - integer, intent(in) :: npart,ntypes + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fext(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: metrics(:,:,:,:),metricderivs(:,:,:,:),dtextforcenew,fext_sinks(:,:) + real, intent(in) :: dt,hdt,timei + integer, intent(in) :: nptmass,ntypes integer, intent(inout) :: pitsmax,xitsmax real, intent(inout) :: perrmax,xerrmax integer :: i,its,ierr,itype integer, parameter :: itsmax = 50 - real :: pmassi + real :: pmassi,xyzhi(4) real :: pri,spsoundi,tempi,gammai - real :: fstar_sinks(4,npart) real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) real :: x_err,pmom_err @@ -1276,8 +1307,6 @@ subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & integer :: merge_ij(2),merge_n real :: dtsinksink - call get_accel_sink_sink(npart,xyzh,fstar_sinks,epot_sinksink,dtsinksink,& - iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) !--------------------------- ! predictor during substeps !--------------------------- @@ -1285,42 +1314,43 @@ subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & ! predictor step for external forces, also recompute external forces ! !$omp parallel do default(none) & - !$omp shared(npart,xyzh,vxyzu,fext,iphase,ntypes,massoftype) & + !$omp shared(xyzmh_ptmass,vxyz_ptmass,fext,iphase,ntypes,massoftype) & !$omp shared(maxphase,maxp,eos_vars) & !$omp shared(dt,hdt,xtol,ptol) & - !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & - !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce,fstar_sinks) & - !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi) & + !$omp shared(ieos,pxyzu_ptmass,metrics,metricderivs,ien_type) & + !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce,fext_sinks) & + !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi,xyzhi) & !$omp private(converged,pmom_err,x_err,pri,ierr,gammai) & !$omp firstprivate(pmassi,itype) & !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & !$omp reduction(min:dtextforcenew) - predictor: do i=1,npart - xyz(1) = xyzh(1,i) - xyz(2) = xyzh(2,i) - xyz(3) = xyzh(3,i) - hi = xyzh(4,i) + predictor: do i=1,nptmass + xyzhi(1) = xyzmh_ptmass(1,i) + xyzhi(2) = xyzmh_ptmass(2,i) + xyzhi(3) = xyzmh_ptmass(3,i) + pmassi = xyzmh_ptmass(4,i) + hi = xyzmh_ptmass(5,i) + + xyz(1) = xyzhi(1) + xyz(2) = xyzhi(2) + xyz(3) = xyzhi(3) + xyzhi(4) = hi if (.not.isdead_or_accreted(hi)) then - if (ntypes > 1 .and. maxphase==maxp) then - itype = iamtype(iphase(i)) - pmassi = massoftype(itype) - endif - its = 0 converged = .false. ! ! make local copies of array quantities ! - pxyz(1:3) = pxyzu(1:3,i) + pxyz(1:3) = pxyzu_ptmass(1:3,i) eni = 0. - vxyz(1:3) = vxyzu(1:3,i) + vxyz(1:3) = vxyz_ptmass(1:3,i) uui = 0. fexti = fext(:,i) pxyz = pxyz + hdt*fexti !-- unpack thermo variables for the first guess in cons2prim - densi = dens(i) + densi = 1. pri = 0. gammai = 0. tempi = 0. @@ -1331,13 +1361,12 @@ subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & its = its + 1 pprev = pxyz call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& - tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - call combine_forces_gr_one(fstar_sinks(1:3,i),fstar(1:3)) - ! fstar = fstar_sinks(1:3,i) + call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + call combine_forces_gr_one(fext_sinks(1:3,i),fstar(1:3)) pxyz = pprev + hdt*(fstar - fexti) pmom_err = maxval(abs(pxyz - pprev)) @@ -1383,11 +1412,10 @@ subroutine predict_gr_sink(xyzh,vxyzu,ntypes,pxyzu,fext,npart,dt,timei,hdt, & xerrmax = max(x_err,xerrmax) ! re-pack arrays back where they belong - xyzh(1:3,i) = xyz(1:3) - pxyzu(1:3,i) = pxyz(1:3) - vxyzu(1:3,i) = vxyz(1:3) - fext(:,i) = fexti - dens(i) = densi + xyzmh_ptmass(1:3,i) = xyz(1:3) + pxyzu_ptmass(1:3,i) = pxyz(1:3) + vxyz_ptmass(1:3,i) = vxyz(1:3) + fext(:,i) = fexti ! Skip remainder of update if boundary particle; note that fext==0 for these particles if (iamboundary(itype)) cycle predictor @@ -1403,7 +1431,10 @@ end subroutine predict_gr_sink !+ !---------------------------------------------------------------- subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& - pxyzu,accretedmass,hdt,npart,ntypes,dtextforce_min,timei) + pxyzu,accretedmass,hdt,npart,nptmass,ntypes,dtextforce_min,timei,& + xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& + metrics_ptmass,metricderivs_ptmass,& + pxyzu_ptmass,nlive_sinks,naccreted_sinks) use dim, only:maxptmass,maxp,maxvxyzu,use_apr use io, only:master,warning,fatal @@ -1418,28 +1449,53 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, use extern_gr, only:get_grforce use metric_tools, only:pack_metric,pack_metricderivs use damping, only:calc_damp,apply_damp,idamp + use part, only:epot_sinksink + use ptmass, only:get_accel_sink_sink,get_accel_sink_gas real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - integer, intent(in) :: npart,ntypes + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:) + integer, intent(in) :: npart,ntypes,nptmass integer, intent(inout) :: nlive,naccreted + integer, intent(inout) :: nlive_sinks,naccreted_sinks real, intent(inout) :: accretedmass real, intent(in) :: hdt,timei - real, intent(out) :: dtextforce_min + real, intent(inout) :: dtextforce_min logical :: accreted integer :: i,itype real :: pmassi real :: dtf real :: pri,spsoundi,pondensi,tempi - real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) - !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) real :: damp_fac ! real, save :: dmdt = 0. integer, parameter :: itsmax = 50 - + real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) + real :: dtphi2,dtsinksink,fonrmax,poti + integer :: merge_ij(nptmass),merge_n + real :: fext_gas(4,npart),fext_sinks(4,nptmass) + + pmassi = massoftype(igas) + itype = igas + fext_gas = 0. + fext_sinks = 0. + + !---------------------------------------------- + ! calculate acceleration sink-sink + !---------------------------------------------- + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_sinks,epot_sinksink,dtsinksink,& + iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) + + dtextforce_min = min(dtextforce_min,C_force*dtsinksink) + !$omp parallel default(none) & !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,fext,iphase,ntypes,massoftype,hdt,timei) & + !$omp shared(nptmass,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass) & + !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass) & !$omp shared(maxphase,maxp,aprmassoftype,apr_level) & + !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass) & + !$omp shared(bin_info,dtphi2,poti,fonrmax) & + !$omp shared(fext_gas,fext_sinks) & !$omp private(i,accreted) & !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & !$omp private(pri,pondensi,spsoundi,tempi,dtf) & @@ -1453,7 +1509,6 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, if (ntypes > 1 .and. maxphase==maxp) then itype = iamtype(iphase(i)) if (use_apr) then - pmassi = aprmassoftype(itype,apr_level(i)) else pmassi = massoftype(itype) endif @@ -1464,8 +1519,15 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, call equationofstate(ieos,pondensi,spsoundi,dens(i),xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi,vxyzu(4,i)) pri = pondensi*dens(i) + + call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzmh_ptmass, & + fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_sinks,& + dsdt_ptmass,fonrmax,dtphi2,bin_info) + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pri,fext(1:3,i),dtf) - dtextforce_min = min(dtextforce_min,C_force*dtf) + call combine_forces_gr_one(fext_gas(1:3,i),fext(1:3,i)) + + dtextforce_min = min(dtextforce_min,C_force*dtf,C_force*sqrt(dtphi2)) if (idamp > 0) then call apply_damp(fext(1,i), fext(2,i), fext(3,i), vxyzu(1:3,i), xyzh(1:3,i), damp_fac) @@ -1490,7 +1552,9 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, enddo accreteloop !$omp enddo !$omp end parallel - + call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fext_sinks,& + metrics_ptmass,metricderivs_ptmass,nlive_sinks,naccreted_sinks,pxyzu_ptmass,& + accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) end subroutine accrete_gr !---------------------------------------------------------------- @@ -1498,93 +1562,79 @@ end subroutine accrete_gr ! routine for accretion step in GR case !+ !---------------------------------------------------------------- - subroutine accrete_gr_sink(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& - pxyzu,accretedmass,hdt,npart,ntypes,dtextforce_min,timei) - - use dim, only:maxptmass,maxp,maxvxyzu - use io, only:master,warning,fatal - use externalforces, only:externalforce,accrete_particles,update_externalforce + subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptmass,metricderivs_ptmass,& + nlive_sinks,naccreted_sinks,& + pxyzu_ptmass,accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) + use part, only:ihsoft + use externalforces, only:accrete_particles use options, only:iexternalforce - use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& - massoftype,rhoh,igamma,itemp,igasP,epot_sinksink,dsdt_ptmass - use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,C_force - use eos, only:equationofstate,ieos use cons2primsolver,only:conservative2primitive use extern_gr, only:get_grforce - use metric_tools, only:pack_metric,pack_metricderivs - use damping, only:calc_damp,apply_damp,idamp - use ptmass, only:get_accel_sink_sink - real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - integer, intent(in) :: npart,ntypes - integer, intent(inout) :: nlive,naccreted + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fext(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),fext_sinks(:,:) + integer, intent(in) :: nptmass + integer, intent(inout) :: nlive_sinks,naccreted_sinks real, intent(inout) :: accretedmass - real, intent(in) :: hdt,timei - real, intent(out) :: dtextforce_min + real, intent(in) :: hdt,timei,dtsinksink + real, intent(inout) :: dtextforce_min logical :: accreted - integer :: i,itype - real :: pmassi - real :: dtf - real :: pri,spsoundi,pondensi,tempi - real :: fstar_sinks(4,npart) - real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) - integer :: merge_ij(2),merge_n - real :: dtsinksink - integer :: iexternalforce_n - !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) - real :: damp_fac + integer :: i + real :: xyzhi(4),pmassi,densi,pri + real :: dtf,hsofti ! real, save :: dmdt = 0. integer, parameter :: itsmax = 50 - call get_accel_sink_sink(npart,xyzh,fstar_sinks,epot_sinksink,dtsinksink,& - iexternalforce_n,timei,merge_ij,merge_n,dsdt_ptmass) !$omp parallel default(none) & - !$omp shared(npart,xyzh,metrics,metricderivs,vxyzu,fext,iphase,ntypes,massoftype,hdt,timei) & - !$omp shared(maxphase,maxp) & - !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,fstar_sinks) & + !$omp shared(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,vxyz_ptmass,fext,hdt,timei) & + !$omp shared(dtsinksink,fext_sinks) & !$omp private(i,accreted) & - !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & - !$omp private(pri,pondensi,spsoundi,tempi,dtf) & - !$omp firstprivate(itype,pmassi) & + !$omp shared(pxyzu_ptmass,iexternalforce,C_force) & + !$omp private(dtf,xyzhi,hsofti,pmassi,pri,densi) & !$omp reduction(min:dtextforce_min) & - !$omp reduction(+:accretedmass,naccreted,nlive) & - !$omp shared(idamp,damp_fac) + !$omp reduction(+:accretedmass,naccreted_sinks,nlive_sinks) !$omp do - - accreteloop: do i=1,npart - pmassi = xyzh(4,i) + accreteloop: do i=1,nptmass pri = 0. + densi = 1. ! add this force due to the curvature of the metric. - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),0.,pri,fext(1:3,i),dtf) - call combine_forces_gr_one(fstar_sinks(1:3,i),fext(1:3,i)) - - if (all(abs(fstar_sinks(1:3,i) - fext(1:3,i)) < epsilon(0.))) then - dtextforce_min = C_force*dtsinksink - else - dtextforce_min = min(dtextforce_min,C_force*dtf,C_force*dtsinksink) - endif + xyzhi(1:3) = xyzmh_ptmass(1:3,i) - if (idamp > 0) then - call apply_damp(fext(1,i), fext(2,i), fext(3,i), vxyzu(1:3,i), xyzh(1:3,i), damp_fac) - endif + ! if a sink particle is already eaten by the black hole, skip it... + pmassi = xyzmh_ptmass(4,i) + if (pmassi < 0.) cycle accreteloop + ! + ! the smoothing length is used inside get_grforce to set the timestep based + ! on h/abs(dp/dt), but for sink particles this is meaningless unless + ! a softening length is set + ! + hsofti = xyzmh_ptmass(ihsoft,i) + xyzhi(4) = huge(0.) + if (hsofti > 0.) xyzhi(4) = hsofti + call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),densi,0.,pri,fext(1:3,i),dtf) + call combine_forces_gr_one(fext_sinks(1:3,i),fext(1:3,i)) + dtextforce_min = min(dtextforce_min,C_force*dtf) ! ! correct v to the full step using only the external force ! - pxyzu(1:3,i) = pxyzu(1:3,i) + hdt*fext(1:3,i) - ! Do we need call cons2prim here ?? + pxyzu_ptmass(1:3,i) = pxyzu_ptmass(1:3,i) + hdt*fext(1:3,i) if (iexternalforce > 0) then - call accrete_particles(iexternalforce,xyzh(1,i),xyzh(2,i), & - xyzh(3,i),xyzh(5,i),pmassi,timei,accreted,i) + ! + ! sending the mass twice here is deliberate, as an accreted sink particle is indicated by + ! a negative mass, unlike gas particles which are flagged with a negative smoothing length + ! + call accrete_particles(iexternalforce,xyzmh_ptmass(1,i),xyzmh_ptmass(2,i), & + xyzmh_ptmass(3,i),xyzmh_ptmass(4,i),xyzmh_ptmass(4,i),timei,accreted) if (accreted) then - accretedmass = accretedmass + pmassi - naccreted = naccreted + 1 + accretedmass = accretedmass + abs(xyzmh_ptmass(4,i)) + naccreted_sinks = naccreted_sinks + 1 endif endif - nlive = nlive + 1 + nlive_sinks = nlive_sinks + 1 enddo accreteloop !$omp enddo From c0b530a14c3926e5cffb012e7ab07115b0ff7226 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:05:50 +1100 Subject: [PATCH 27/54] (gr tde) shift xyzmh and vxyz arrays --- src/setup/setup_grtde.f90 | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 655ce0eb5..37e2ed113 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -33,7 +33,6 @@ module setup public :: setpart real :: mhole,beta,ecc_bh,norbits,theta_bh - real :: a_binary real :: x1,y1,z1,x2,y2,z2 real :: vx1,vy1,vz1,vx2,vy2,vz2 integer :: dumpsperorbit,nstar @@ -70,7 +69,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, use gravwaveutils, only:theta_gw,calc_gravitwaves use setup_params, only:rhozero,npart_total use systemutils, only:get_command_option - use options, only:iexternalforce,damp + use options, only:iexternalforce integer, intent(in) :: id integer, intent(inout) :: npart integer, intent(out) :: npartoftype(:) @@ -81,10 +80,9 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, character(len=20), intent(in) :: fileprefix real, intent(out) :: vxyzu(:,:) character(len=120) :: filename - character(len=20) :: semi_major_axis character(len=20) :: semi_major_axis_str integer :: ierr,np_default - integer :: nptmass_in,iextern_prev + integer :: nptmass_in integer :: i,ios logical :: iexist,write_profile,use_var_comp real :: rtidal,rp,semia,period,hacc1,hacc2 @@ -101,6 +99,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, polyk = 1.e-10 ! <== uconst gamma = 5./3. ieos = 2 + angle = 0. if (.not.gravity) call fatal('setup','recompile with GRAVITY=yes') ! !-- space available for injected gas particles @@ -201,8 +200,10 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, accradius1_hard = 5.*mass1 accradius1 = accradius1_hard else - accradius1_hard = 6. - accradius1 = accradius1_hard + if (mass1 .ne. 0.) then + accradius1_hard = 6. + accradius1 = accradius1_hard + endif endif a = 0. theta_bh = theta_bh*pi/180. @@ -294,8 +295,10 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, xyzmh_ptmass_in(4,2) = star(2)%mstar xyzmh_ptmass_in(5,2) = star(2)%hacc else - xyzmh_ptmass_in(1:3,1) = xyzmh_ptmass_in(1:3,1) + xyzstar(:) - vxyz_ptmass_in(1:3,1) = vxyz_ptmass_in(1:3,1) + vxyzstar(:) + do i = 1, nstar + xyzmh_ptmass_in(1:3,i) = xyzmh_ptmass_in(1:3,i) + xyzstar(:) + vxyz_ptmass_in(1:3,i) = vxyz_ptmass_in(1:3,i) + vxyzstar(:) + enddo endif call shift_stars(nstar,star,xyzmh_ptmass_in,vxyz_ptmass_in,& From dcc0399acd1af90a2bf2fd1a20932ccf42d8d9ca Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:06:31 +1100 Subject: [PATCH 28/54] (gr_sink) get force from sink-gas interaction as well now --- src/main/step_leapfrog.F90 | 40 +++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index e42d9d3e3..d6d4ec443 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -106,7 +106,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) use mpiutils, only:reduceall_mpi use part, only:nptmass,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass, & dsdt_ptmass,fsink_old,ibin_wake,dptmass,linklist_ptmass, & - pxyzu_ptmass,metrics_ptmass,dens_ptmass + pxyzu_ptmass,metrics_ptmass use part, only:n_group,n_ingroup,n_sing,gtgrad,group_info,bin_info,nmatrix use io_summary, only:summary_printout,summary_variable,iosumtvi,iowake, & iosumflrp,iosumflrps,iosumflrc @@ -128,7 +128,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) use cons2primsolver, only:conservative2primitive,primitive2conservative use substepping, only:substep,substep_gr, & substep_sph_gr,substep_sph,combine_forces_gr - use ptmass, only:get_accel_sink_sink + use ptmass, only:get_accel_sink_sink,get_accel_sink_gas integer, intent(inout) :: npart integer, intent(in) :: nactive @@ -141,6 +141,8 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) real :: alphaloci,source,tdecay1,hi,rhoi,ddenom,spsoundi real :: v2mean,hdti real :: dtsinksink + real :: fonrmax,poti,dtphi2 + real :: fext_gas(4,npart),fext_sinks(4,nptmass) integer :: merge_ij(nptmass) integer :: merge_n real(kind=4) :: t1,t2,tcpu1,tcpu2 @@ -153,6 +155,9 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) ! ! set initial quantities ! + + fext_gas = 0. + fext_sinks = 0. timei = t hdtsph = 0.5*dtsph dterr = bignumber @@ -244,26 +249,33 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) !---------------------------------------------------------------------- call get_timings(t1,tcpu1) if (gr) then + ! first calculate all the force arrays if (nptmass > 0) then - call cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass,dens_ptmass) + call cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& - vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) + vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) + else + do i=1,npart + call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzmh_ptmass, & + fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fxyz_ptmass,& + dsdt_ptmass,fonrmax,dtphi2,bin_info) + enddo + call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) + call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) + call combine_forces_gr(npart,fext_gas,fext) + endif + if ((iexternalforce > 0 .and. imetric /= imet_minkowski) .or. idamp > 0 .or. nptmass > 0 .or. & + (nptmass > 0 .and. imetric == imet_minkowski)) then + ! for now use the minimum of the two timesteps as dtextforce - dtextforce = min(dtextforce, dtsinksink) - - ! perform substepping for the sink particles - call substep_gr(nptmass,ntypes,dtsph,dtextforce,xyzmh_ptmass,vxyz_ptmass,& - pxyzu_ptmass,dens_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass,time=t,use_sink=.true.) - endif - if ((iexternalforce > 0 .and. imetric /= imet_minkowski) .or. idamp > 0) then - call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) - call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtextforce) - call substep_gr(npart,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t) + dtextforce = min(dtextforce, dtsinksink, dtphi2) + call substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t,& + xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) else call substep_sph_gr(dtsph,npart,xyzh,vxyzu,dens,pxyzu,metrics) endif From fa3819e685c20c1efab7f5d1e87d8b318305e695 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 16:06:53 +1100 Subject: [PATCH 29/54] (gr sink) dens_ptmass no longer needed --- src/tests/test_gr.f90 | 10 +++++++--- src/tests/test_ptmass.f90 | 17 ++++++++--------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/src/tests/test_gr.f90 b/src/tests/test_gr.f90 index 71c38f225..a0c9dd0ef 100644 --- a/src/tests/test_gr.f90 +++ b/src/tests/test_gr.f90 @@ -165,7 +165,9 @@ end subroutine test_inccirc !----------------------------------------------------------------------- subroutine integrate_geodesic(tmax,dt,xyz,vxyz,angmom0,angmom) use io, only:iverbose - use part, only:igas,npartoftype,massoftype,set_particle_type,get_ntypes,ien_type + use part, only:igas,npartoftype,massoftype,set_particle_type,get_ntypes,ien_type,& + xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,& + metricderivs_ptmass,fxyz_ptmass,nptmass use substepping, only:substep_gr use eos, only:ieos use cons2prim, only:prim2consall @@ -209,7 +211,7 @@ subroutine integrate_geodesic(tmax,dt,xyz,vxyz,angmom0,angmom) call init_metric(npart,xyzh,metrics,metricderivs) call prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens=.false.,dens=dens) - call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,dens,fext,dtextforce) + call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) call calculate_angmom(xyzh(1:3,1),metrics(:,:,:,1),massi,vxyzu(1:3,1),angmom0) nsteps = 0 @@ -217,7 +219,9 @@ subroutine integrate_geodesic(tmax,dt,xyz,vxyz,angmom0,angmom) nsteps = nsteps + 1 time = time + dt dtextforce = blah - call substep_gr(npart,ntypes,dt,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time) + ! call substep_gr(npart,ntypes,dt,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time) + call substep_gr(npart,nptmass,ntypes,dt,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time,& + xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) enddo call calculate_angmom(xyzh(1:3,1),metrics(:,:,:,1),massi,vxyzu(1:3,1),angmom) diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 25e6f7ad9..a37328770 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -466,7 +466,8 @@ subroutine test_sink_binary_gr(ntests,npass,string) use io, only:id,master,iverbose use part, only:init_part,npart,npartoftype,nptmass,xyzmh_ptmass,vxyz_ptmass,& epot_sinksink,metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& - dens_ptmass,fxyz_ptmass + fxyz_ptmass,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,& + fext use timestep, only:C_force,dtextforce,dtmax use physcon, only:solarm,pi use units, only:set_units @@ -488,7 +489,7 @@ subroutine test_sink_binary_gr(ntests,npass,string) real :: m1,m2,a,ecc,hacc1,hacc2,t,dt,tol_en real :: dtsinksink,tol,omega,errmax,dis real :: angmomin,etotin,totmomin,dtsph - integer :: ierr,nerr,nfailed(6),nwarn,nsteps,i + integer :: ierr,nerr,nfailed(6),nwarn,nsteps,i,ntypes integer :: merge_ij(2),merge_n,norbits character(len=20) :: dumpfile ! @@ -534,12 +535,12 @@ subroutine test_sink_binary_gr(ntests,npass,string) call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& - vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,dens=dens_ptmass,use_sink=.true.) + vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) ! sinks in GR, provide external force due to metric to determine the sink total force call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& - vxyz_ptmass,dens_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) + vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fxyz_sinksink,fxyz_ptmass) ! Test the force calculated is same as sink-sink because there is no curvature. @@ -588,13 +589,11 @@ subroutine test_sink_binary_gr(ntests,npass,string) dumpfile='test_00000' call init_step(nptmass,t,dtmax) - + ntypes = 2 do i=1,nsteps dtsph = dt - - call substep_gr(nptmass,nptmass,dtsph,dtextforce,xyzmh_ptmass,vxyz_ptmass,& - pxyzu_ptmass,dens_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass,time=t,use_sink=.true.) - + call substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t,& + xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) call compute_energies(t) errmax = max(errmax,abs(etot - etotin)) t = t + dt From e94e55367fa5456483398c40c6d7afb8a7ecfb6d Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:33:43 +1100 Subject: [PATCH 30/54] (gr_sink) working gr sink particles test --- src/main/extern_gr.f90 | 6 ++++-- src/main/step_leapfrog.F90 | 4 ++-- src/main/substepping.F90 | 11 ++++------- src/tests/test_ptmass.f90 | 24 ++++++++++++------------ 4 files changed, 22 insertions(+), 23 deletions(-) diff --git a/src/main/extern_gr.f90 b/src/main/extern_gr.f90 index 8ab382709..eeb7a6ef2 100644 --- a/src/main/extern_gr.f90 +++ b/src/main/extern_gr.f90 @@ -112,9 +112,10 @@ end subroutine get_grforce_all subroutine dt_grforce(xyzh,fext,dtf) use physcon, only:pi use metric_tools, only:imetric,imet_schwarzschild,imet_kerr + use metric, only:mass1 real, intent(in) :: xyzh(4),fext(3) real, intent(out) :: dtf - real :: r,r2,dtf1,dtf2,f2i + real :: r,r2,dtf1,dtf2,f2i,omega integer, parameter :: steps_per_orbit = 100 f2i = fext(1)*fext(1) + fext(2)*fext(2) + fext(3)*fext(3) @@ -128,7 +129,8 @@ subroutine dt_grforce(xyzh,fext,dtf) case (imet_schwarzschild,imet_kerr) r2 = xyzh(1)*xyzh(1) + xyzh(2)*xyzh(2) + xyzh(3)*xyzh(3) r = sqrt(r2) - dtf2 = (2.*pi*sqrt(r*r2))/steps_per_orbit + omega = sqrt(mass1/(r2*r)) + dtf2 = (2.*pi/(omega + epsilon(omega)))/steps_per_orbit case default dtf2 = huge(dtf2) end select diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index d6d4ec443..08320d0a7 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -102,7 +102,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) fext_ptmass use options, only:avdecayconst,alpha,ieos,alphamax use deriv, only:derivs - use timestep, only:dterr,bignumber,tolv + use timestep, only:dterr,bignumber,tolv,C_force use mpiutils, only:reduceall_mpi use part, only:nptmass,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass, & dsdt_ptmass,fsink_old,ibin_wake,dptmass,linklist_ptmass, & @@ -273,7 +273,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) (nptmass > 0 .and. imetric == imet_minkowski)) then ! for now use the minimum of the two timesteps as dtextforce - dtextforce = min(dtextforce, dtsinksink, dtphi2) + dtextforce = min(dtextforce, C_force*dtsinksink, C_force*sqrt(dtphi2)) call substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t,& xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) else diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 82779949c..08c8f9004 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1294,10 +1294,10 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex integer, intent(inout) :: pitsmax,xitsmax real, intent(inout) :: perrmax,xerrmax - integer :: i,its,ierr,itype + integer :: i,its,ierr integer, parameter :: itsmax = 50 real :: pmassi,xyzhi(4) - real :: pri,spsoundi,tempi,gammai + real :: pri,tempi,gammai real, save :: pprev(3),xyz_prev(3),fstar(3),vxyz_star(3),xyz(3),pxyz(3),vxyz(3),fexti(3) !$omp threadprivate(pprev,xyz_prev,fstar,vxyz_star,xyz,pxyz,vxyz,fexti) real :: x_err,pmom_err @@ -1319,9 +1319,8 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex !$omp shared(dt,hdt,xtol,ptol) & !$omp shared(ieos,pxyzu_ptmass,metrics,metricderivs,ien_type) & !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce,fext_sinks) & - !$omp private(i,its,spsoundi,tempi,rhoi,hi,eni,uui,densi,xyzhi) & - !$omp private(converged,pmom_err,x_err,pri,ierr,gammai) & - !$omp firstprivate(pmassi,itype) & + !$omp private(i,its,tempi,rhoi,hi,eni,uui,densi,xyzhi) & + !$omp private(converged,pmom_err,x_err,pri,ierr,gammai,pmassi) & !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & !$omp reduction(min:dtextforcenew) @@ -1417,8 +1416,6 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex vxyz_ptmass(1:3,i) = vxyz(1:3) fext(:,i) = fexti - ! Skip remainder of update if boundary particle; note that fext==0 for these particles - if (iamboundary(itype)) cycle predictor endif enddo predictor !$omp end parallel do diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index a37328770..96558cce1 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -468,7 +468,7 @@ subroutine test_sink_binary_gr(ntests,npass,string) epot_sinksink,metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& fxyz_ptmass,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,& fext - use timestep, only:C_force,dtextforce,dtmax + use timestep, only:C_force,dtextforce use physcon, only:solarm,pi use units, only:set_units use setbinary, only:set_binary @@ -481,14 +481,13 @@ subroutine test_sink_binary_gr(ntests,npass,string) use extern_gr, only:get_grforce_all use substepping, only:combine_forces_gr use energies, only:angtot,etot,totmom,compute_energies,epot - use step_lf_global, only:init_step use substepping, only:substep_gr integer, intent(inout) :: ntests,npass character(len=*), intent(in) :: string real :: fxyz_sinksink(4,2),dsdt_sinksink(3,2) ! we only use 2 sink particles in the tests here real :: m1,m2,a,ecc,hacc1,hacc2,t,dt,tol_en real :: dtsinksink,tol,omega,errmax,dis - real :: angmomin,etotin,totmomin,dtsph + real :: angmomin,etotin,totmomin,dtsph,dtorb,vphi integer :: ierr,nerr,nfailed(6),nwarn,nsteps,i,ntypes integer :: merge_ij(2),merge_n,norbits character(len=20) :: dumpfile @@ -510,12 +509,13 @@ subroutine test_sink_binary_gr(ntests,npass,string) hacc2 = 0.75 mass1 = 0. ! set BH mass as 0. So the metric becomes Minkowski t = 0. + iverbose = 0 ! chose a very small value because a value of 0.35 was resulting in distance - distance_init of 1.e-3 ! but using a small timestep resulted in values smaller than equal to 1.e-4 C_force = 0.25 - norbits = 2 tol = epsilon(0.) omega = sqrt((m1+m2)/a**3) + vphi = a*omega ! set sinks around each other call set_units(mass=1.e6*solarm,c=1.d0,G=1.d0) call set_binary(m1,m2,a,ecc,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,verbose=.false.) @@ -559,8 +559,7 @@ subroutine test_sink_binary_gr(ntests,npass,string) ! !--check energy and angular momentum of the system ! - dtextforce = C_force*dtsinksink - dtmax = max(dtextforce, dtsinksink) + dtextforce = min(C_force*dtsinksink,dtextforce) dt = dtextforce call compute_energies(t) etotin = etot @@ -583,13 +582,14 @@ subroutine test_sink_binary_gr(ntests,npass,string) ! !--determine number of steps per orbit for information ! - nsteps = int(2.*pi/omega/dt) + 1 - nsteps = nsteps*norbits + dtorb = 2.*pi/omega + dt = dtorb + norbits = 100 + nsteps = norbits*nint(dtorb/dt) errmax = 0. dumpfile='test_00000' - - call init_step(nptmass,t,dtmax) ntypes = 2 + do i=1,nsteps dtsph = dt call substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t,& @@ -602,12 +602,12 @@ subroutine test_sink_binary_gr(ntests,npass,string) ! !--check the radius of the orbit does not change ! - call checkval(dis,a,1.e-4,nfailed(1),"radius of orbit") + call checkval(dis,a,7.e-4,nfailed(1),"radius of orbit") call update_test_scores(ntests,nfailed,npass) ! !--check energy, linear and angular momentum conservation ! - tol_en = 1.e-10 + tol_en = 1.e-13 call compute_energies(t) call checkval(angtot,angmomin,tol_en,nfailed(1),'angular momentum') call checkval(totmom,totmomin,tol_en,nfailed(2),'linear momentum') From 11fd71ff7ce4af3829485947b157e2211dda7249 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:43:28 +1100 Subject: [PATCH 31/54] [format-bot] obsolete .gt. .lt. .ge. .le. .eq. .ne. replaced --- src/setup/setup_grtde.f90 | 6 +++--- src/utils/analysis_kepler.f90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 37e2ed113..25fe39fb9 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -200,7 +200,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, accradius1_hard = 5.*mass1 accradius1 = accradius1_hard else - if (mass1 .ne. 0.) then + if (mass1 /= 0.) then accradius1_hard = 6. accradius1 = accradius1_hard endif @@ -341,7 +341,7 @@ subroutine write_setupfile(filename) call write_inopt(provide_params,'provide_params','initial conditions',iunit) call write_inopt(nstar, 'nstar', 'number of stars to set',iunit) - if (nstar .ne. 0) then + if (nstar /= 0) then if (nstar == 1) then call write_options_star(star(1),iunit) call write_inopt(relax,'relax','relax star into hydrostatic equilibrium',iunit) @@ -405,7 +405,7 @@ subroutine read_setupfile(filename,ieos,polyk,mass1,ierr) ! !--read star options and convert to code units ! - if (nstar .ne. 0) then + if (nstar /= 0) then if (nstar == 1) then call read_options_star(star(1),need_iso,ieos,polyk,db,nerr) call read_inopt(relax,'relax',db,errcount=nerr) diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index 7c0d8d5ef..3dda1122c 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -704,7 +704,7 @@ subroutine no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no double_the_no = .False. endif else - if (double_the_no == .False. .and. j .ne. count_particles) then + if (double_the_no == .False. .and. j /= count_particles) then if (100*(pos_mag_next-rad_inner)/rad_inner > 30) then !print*,(((pos_mag_next-rad_inner)/rad_inner)*100),"per inc",j,"j",count_particles,"count_particles" write(15,*) pos_mag_next,rad_inner,j,number_per_bin @@ -1276,12 +1276,12 @@ subroutine calculate_temp_cut(temperature_array,count_bound,temp_cut,max_temp,te ! Define the temperature to cut the model at temp_cut = temp_array_new(count_cut_index) - if (temp_cut .ne. max_temp) then + if (temp_cut /= max_temp) then temp_found = .true. endif ! If we get the temp_cut as 0. K and the count_loops_temp is 1, then we accept that as a true value - if (temp_cut .eq. 0.0 .and. count_loops_temp /= 1) then + if (temp_cut == 0.0 .and. count_loops_temp /= 1) then temp_found = .false. endif print*,temp_cut,"TEMP CUT" From 44975e9058dd8f6cbb996a57af5d30ed6009fe36 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:43:39 +1100 Subject: [PATCH 32/54] [format-bot] F77-style SHOUTING removed --- src/utils/analysis_kepler.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index 3dda1122c..b4fcbea7f 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -948,7 +948,7 @@ subroutine assign_atomic_mass_and_number(comp_label,A_array,Z_array) real,allocatable :: A_array(:), Z_array(:) integer :: size_to_allocate, i - if ( ANY( comp_label=="nt1" ) ) then + if ( any( comp_label=="nt1" ) ) then size_to_allocate = size(comp_label(:))-1 else From b5c169b3f69a921a1806032749afaad6a9e81562 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:44:20 +1100 Subject: [PATCH 33/54] [header-bot] updated file headers --- src/main/cons2prim.f90 | 2 +- src/main/extern_gr.f90 | 3 ++- src/main/initial.F90 | 4 +-- src/main/inject_windtunnel.f90 | 1 - src/main/relaxem.f90 | 2 +- src/main/step_leapfrog.F90 | 4 +-- src/setup/relax_star.f90 | 3 +-- src/setup/set_star_utils.f90 | 4 +-- src/setup/setup_grtde.f90 | 34 ++++++++++++++++++-------- src/setup/setup_windtunnel.f90 | 6 ++--- src/tests/test_apr.f90 | 4 +-- src/tests/test_ptmass.f90 | 9 ++++--- src/tests/test_setstar.f90 | 4 ++- src/tests/testsuite.F90 | 2 +- src/utils/analysis_common_envelope.f90 | 7 +++--- src/utils/analysis_kepler.f90 | 4 +-- 16 files changed, 55 insertions(+), 38 deletions(-) diff --git a/src/main/cons2prim.f90 b/src/main/cons2prim.f90 index ad80dcad8..94573f7bb 100644 --- a/src/main/cons2prim.f90 +++ b/src/main/cons2prim.f90 @@ -20,7 +20,7 @@ module cons2prim ! Liptai & Price (2019), MNRAS 485, 819-842 ! Ballabio et al. (2018), MNRAS 477, 2766-2771 ! -! :Owner: Elisabeth Borchert +! :Owner: Megha Sharma ! ! :Runtime parameters: None ! diff --git a/src/main/extern_gr.f90 b/src/main/extern_gr.f90 index eeb7a6ef2..166a3b670 100644 --- a/src/main/extern_gr.f90 +++ b/src/main/extern_gr.f90 @@ -17,7 +17,8 @@ module extern_gr ! ! :Runtime parameters: None ! -! :Dependencies: eos, io, metric_tools, part, physcon, timestep, utils_gr +! :Dependencies: eos, io, metric, metric_tools, part, physcon, timestep, +! utils_gr ! implicit none diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 66d31ea4f..a7e79c344 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -23,8 +23,8 @@ module initial ! metric_tools, mf_write, mpibalance, mpidomain, mpimemory, mpitree, ! mpiutils, nicil, nicil_sup, omputils, options, part, partinject, ! porosity, ptmass, radiation_utils, readwrite_dumps, readwrite_infile, -! subgroup, timestep, timestep_ind, timestep_sts, timing, tmunu2grid, -! units, writeheader +! subgroup, substepping, timestep, timestep_ind, timestep_sts, timing, +! tmunu2grid, units, writeheader ! implicit none diff --git a/src/main/inject_windtunnel.f90 b/src/main/inject_windtunnel.f90 index 07f1fa166..c074c78ce 100644 --- a/src/main/inject_windtunnel.f90 +++ b/src/main/inject_windtunnel.f90 @@ -19,7 +19,6 @@ module inject ! - handled_layers : *(integer) number of handled BHL wind layers* ! - hold_star : *1: subtract CM velocity of star particles at each timestep* ! - lattice_type : *0: cubic distribution, 1: closepacked distribution* -! - nstar : *No. of particles making up sphere* ! - pres_inf : *ambient pressure (code units)* ! - rho_inf : *ambient density (code units)* ! - v_inf : *wind speed (code units)* diff --git a/src/main/relaxem.f90 b/src/main/relaxem.f90 index 417896bf1..f7cfe238f 100644 --- a/src/main/relaxem.f90 +++ b/src/main/relaxem.f90 @@ -14,7 +14,7 @@ module relaxem ! ! :Runtime parameters: None ! -! :Dependencies: boundary, deriv, dim, eos, kernel, mpidomain, options, +! :Dependencies: boundary, deriv, dim, eos, io, kernel, mpidomain, options, ! part ! implicit none diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index 08320d0a7..f1eacf2bb 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -24,8 +24,8 @@ module step_lf_global ! ! :Dependencies: boundary_dyn, cons2prim, cons2primsolver, cooling, ! damping, deriv, dim, extern_gr, growth, io, io_summary, metric_tools, -! mpiutils, options, part, porosity, substepping, timestep, timestep_ind, -! timestep_sts, timing +! mpiutils, options, part, porosity, ptmass, substepping, timestep, +! timestep_ind, timestep_sts, timing ! use dim, only:maxp,maxvxyzu,do_radiation,ind_timesteps use part, only:vpred,Bpred,dustpred,ppred diff --git a/src/setup/relax_star.f90 b/src/setup/relax_star.f90 index f081f1f4f..3fa8c407c 100644 --- a/src/setup/relax_star.f90 +++ b/src/setup/relax_star.f90 @@ -20,8 +20,7 @@ module relaxstar ! :Dependencies: apr, checksetup, damping, deriv, dim, dump_utils, ! energies, eos, externalforces, fileutils, infile_utils, initial, io, ! io_summary, linklist, memory, options, part, physcon, ptmass, -! readwrite_dumps, setstar_utils, sortutils, step_lf_global, table_utils, -! units +! readwrite_dumps, setstar_utils, step_lf_global, table_utils, units ! implicit none public :: relax_star,write_options_relax,read_options_relax diff --git a/src/setup/set_star_utils.f90 b/src/setup/set_star_utils.f90 index a841ec0c8..789aed8b2 100644 --- a/src/setup/set_star_utils.f90 +++ b/src/setup/set_star_utils.f90 @@ -14,8 +14,8 @@ module setstar_utils ! ! :Runtime parameters: None ! -! :Dependencies: eos, eos_piecewise, extern_densprofile, io, kernel, part, -! physcon, radiation_utils, readwrite_kepler, readwrite_mesa, +! :Dependencies: dim, eos, eos_piecewise, extern_densprofile, io, kernel, +! part, physcon, radiation_utils, readwrite_kepler, readwrite_mesa, ! rho_profile, setsoftenedcore, sortutils, spherical, table_utils, ! unifdis, units ! diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 25fe39fb9..329789aac 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -10,21 +10,35 @@ module setup ! ! :References: None ! -! :Owner: David Liptai +! :Owner: Megha Sharma ! ! :Runtime parameters: -! - beta : *penetration factor* -! - dumpsperorbit : *number of dumps per orbit* -! - ecc_bh : *eccentricity (1 for parabolic)* -! - mhole : *mass of black hole (solar mass)* -! - norbits : *number of orbits* -! - relax : *relax star into hydrostatic equilibrium* -! - theta_bh : *inclination of orbit (degrees)* +! - beta : *penetration factor* +! - dumpsperorbit : *number of dumps per orbit* +! - ecc_bh : *eccentricity (1 for parabolic)* +! - mhole : *mass of black hole (solar mass)* +! - norbits : *number of orbits* +! - nstar : *number of stars to set* +! - provide_params : *initial conditions* +! - relax : *relax star into hydrostatic equilibrium* +! - theta_bh : *inclination of orbit (degrees)* +! - vx1 : *vel x star 1* +! - vx2 : *vel x star 2* +! - vy1 : *vel y star 1* +! - vy2 : *vel y star 2* +! - vz1 : *vel z star 1* +! - vz2 : *vel z star 2* +! - x1 : *pos x star 1* +! - x2 : *pos x star 2* +! - y1 : *pos y star 1* +! - y2 : *pos y star 2* +! - z1 : *pos z star 1* +! - z2 : *pos z star 2* ! ! :Dependencies: eos, externalforces, gravwaveutils, infile_utils, io, ! kernel, metric, mpidomain, options, part, physcon, relaxstar, -! setbinary, setstar, setup_params, systemutils, timestep, units, -! vectorutils +! setbinary, setorbit, setstar, setup_params, systemutils, timestep, +! units, vectorutils ! use setstar, only:star_t diff --git a/src/setup/setup_windtunnel.f90 b/src/setup/setup_windtunnel.f90 index 0bbc21f56..842198d12 100644 --- a/src/setup/setup_windtunnel.f90 +++ b/src/setup/setup_windtunnel.f90 @@ -18,7 +18,6 @@ module setup ! - gamma : *adiabatic index* ! - handled_layers : *number of handled layers* ! - lattice_type : *0: cubic, 1: close-packed cubic* -! - nstar : *number of particles resolving gas sphere* ! - pres_inf : *wind pressure / dyn cm^2* ! - rho_inf : *wind density / g cm^-3* ! - v_inf : *wind speed / km s^-1* @@ -27,8 +26,9 @@ module setup ! - wind_radius : *injection radius in units of Rstar* ! ! :Dependencies: dim, eos, extern_densprofile, infile_utils, inject, io, -! kernel, mpidomain, part, physcon, rho_profile, setstar_utils, setunits, -! setup_params, table_utils, timestep, unifdis, units +! kernel, mpidomain, part, physcon, relaxstar, rho_profile, +! setstar_utils, setunits, setup_params, table_utils, timestep, unifdis, +! units ! use io, only:master,fatal use inject, only:init_inject,nstar,Rstar,lattice_type,handled_layers,& diff --git a/src/tests/test_apr.f90 b/src/tests/test_apr.f90 index 002768959..eebb5c0f5 100644 --- a/src/tests/test_apr.f90 +++ b/src/tests/test_apr.f90 @@ -14,8 +14,8 @@ module testapr ! ! :Runtime parameters: None ! -! :Dependencies: apr, boundary, dim, io, linklist, mpidomain, mpiutils, -! part, physcon, testutils, unifdis, units +! :Dependencies: apr, boundary, dim, io, mpidomain, mpiutils, part, +! testutils, unifdis ! use testutils, only:checkval,update_test_scores use io, only:id,master,fatal diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 96558cce1..7b07370ba 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -14,11 +14,12 @@ module testptmass ! ! :Runtime parameters: None ! -! :Dependencies: HIIRegion, boundary, centreofmass, checksetup, deriv, dim, -! energies, eos, eos_HIIR, extern_binary, externalforces, gravwaveutils, -! io, kdtree, kernel, mpiutils, options, part, physcon, ptmass, random, +! :Dependencies: HIIRegion, boundary, centreofmass, checksetup, cons2prim, +! deriv, dim, energies, eos, eos_HIIR, extern_binary, extern_gr, +! externalforces, gravwaveutils, io, kdtree, kernel, metric, +! metric_tools, mpiutils, options, part, physcon, ptmass, random, ! setbinary, setdisc, spherical, step_lf_global, stretchmap, subgroup, -! testutils, timestep, timing, units +! substepping, testutils, timestep, timing, units ! use testutils, only:checkval,update_test_scores implicit none diff --git a/src/tests/test_setstar.f90 b/src/tests/test_setstar.f90 index f9474ca05..8fc131adb 100644 --- a/src/tests/test_setstar.f90 +++ b/src/tests/test_setstar.f90 @@ -14,7 +14,9 @@ module testsetstar ! ! :Runtime parameters: None ! -! :Dependencies: +! :Dependencies: checksetup, dim, eos, io, mpidomain, options, part, +! physcon, setstar, setstar_utils, sortutils, table_utils, testutils, +! units ! use testutils, only:checkval,update_test_scores implicit none diff --git a/src/tests/testsuite.F90 b/src/tests/testsuite.F90 index e66c73210..86db01be7 100644 --- a/src/tests/testsuite.F90 +++ b/src/tests/testsuite.F90 @@ -21,7 +21,7 @@ module test ! testgrowth, testindtstep, testiorig, testkdtree, testkernel, testlink, ! testmath, testmpi, testnimhd, testpart, testpoly, testptmass, ! testradiation, testrwdump, testsedov, testsetdisc, testsethier, -! testsmol, teststep, testwind, timing +! testsetstar, testsmol, teststep, testwind, timing ! implicit none public :: testsuite diff --git a/src/utils/analysis_common_envelope.f90 b/src/utils/analysis_common_envelope.f90 index 7843a5bb2..1041d4e04 100644 --- a/src/utils/analysis_common_envelope.f90 +++ b/src/utils/analysis_common_envelope.f90 @@ -15,9 +15,10 @@ module analysis ! :Runtime parameters: None ! ! :Dependencies: centreofmass, dim, dust_formation, energies, eos, -! eos_gasradrec, eos_mesa, extern_corotate, io, ionization_mod, kernel, -! mesa_microphysics, part, physcon, prompting, ptmass, setbinary, -! sortutils, table_utils, units, vectorutils +! eos_gasradrec, eos_idealplusrad, eos_mesa, extern_corotate, io, +! ionization_mod, kernel, mesa_microphysics, part, physcon, prompting, +! ptmass, radiation_utils, setbinary, sortutils, table_utils, units, +! vectorutils ! use part, only:xyzmh_ptmass,vxyz_ptmass,nptmass,poten,ihsoft,ihacc,& diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index b4fcbea7f..e132f4f67 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -1,8 +1,8 @@ !--------------------------------------------------------------------------! ! The Phantom Smoothed Particle Hydrodynamics code, by Daniel Price et al. ! -! Copyright (c) 2007-2023 The Authors (see AUTHORS) ! +! Copyright (c) 2007-2024 The Authors (see AUTHORS) ! ! See LICENCE file for usage and distribution conditions ! -! http://phantomsph.bitbucket.io/ ! +! http://phantomsph.github.io/ ! !--------------------------------------------------------------------------! module analysis ! From 14e5b08ffa3826544d07aca671e90febeaeeaf30 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:44:27 +1100 Subject: [PATCH 34/54] [space-bot] whitespace at end of lines removed --- src/main/checksetup.f90 | 2 +- src/main/cons2prim.f90 | 36 ++++---- src/main/energies.F90 | 18 ++-- src/main/extern_gr.f90 | 12 +-- src/main/initial.F90 | 14 +-- src/main/ptmass.F90 | 2 +- src/main/step_leapfrog.F90 | 8 +- src/main/substepping.F90 | 70 +++++++------- src/setup/setup_grtde.f90 | 122 ++++++++++++------------- src/setup/setup_windtunnel.f90 | 2 +- src/tests/test_ptmass.f90 | 48 +++++----- src/utils/analysis_common_envelope.f90 | 8 +- src/utils/analysis_kepler.f90 | 58 ++++++------ 13 files changed, 200 insertions(+), 200 deletions(-) diff --git a/src/main/checksetup.f90 b/src/main/checksetup.f90 index eacd61667..a6c7be71b 100644 --- a/src/main/checksetup.f90 +++ b/src/main/checksetup.f90 @@ -410,7 +410,7 @@ subroutine check_setup(nerror,nwarn,restart) ! if (gr) call check_gr(npart,nerror,xyzh,vxyzu) ! -!--check sink GR setup +!--check sink GR setup ! if (gr) call check_gr(nptmass,nerror,xyzmh_ptmass,vxyz_ptmass) ! diff --git a/src/main/cons2prim.f90 b/src/main/cons2prim.f90 index 94573f7bb..c853ef48b 100644 --- a/src/main/cons2prim.f90 +++ b/src/main/cons2prim.f90 @@ -64,21 +64,21 @@ subroutine prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens,dens,use_sink) else usedens = .false. endif - + !$omp parallel do default (none) & !$omp shared(xyzh,metrics,vxyzu,dens,pxyzu,npart,usedens,ien_type,eos_vars,gamma,ieos,use_sink,use_dens) & !$omp private(i,pri,tempi,xyzhi,vxyzui,densi) do i=1,npart - if (present(use_sink)) then + if (present(use_sink)) then xyzhi(1:3) = xyzh(1:3,i) ! save positions - xyzhi(4) = xyzh(5,i) ! save smoothing length, h + xyzhi(4) = xyzh(5,i) ! save smoothing length, h vxyzui(1:3) = vxyzu(1:3,i) vxyzui(4) = 0. ! assume energy as 0. for sink - densi = 1. + densi = 1. call prim2consi(xyzhi,metrics(:,:,:,i),vxyzui,pri,tempi,pxyzu(:,i),ien_type,& - use_sink=use_sink,dens_i=densi) ! this returns temperature and pressure as 0. - else + use_sink=use_sink,dens_i=densi) ! this returns temperature and pressure as 0. + else if (.not.isdead_or_accreted(xyzh(4,i))) then call prim2consi(xyzh(:,i),metrics(:,:,:,i),vxyzu(:,i),pri,tempi,pxyzu(:,i),ien_type,& use_dens=usedens,dens_i=dens(i)) @@ -93,7 +93,7 @@ subroutine prim2consall(npart,xyzh,metrics,vxyzu,pxyzu,use_dens,dens,use_sink) eos_vars(igamma,i) = gamma endif endif - endif + endif enddo !$omp end parallel do @@ -136,14 +136,14 @@ subroutine prim2consi(xyzhi,metrici,vxyzui,pri,tempi,pxyzui,ien_type,use_dens,us if (usedens) then densi = dens_i else - if (present(use_sink)) then - densi = 1. ! using a value of 0. results in NaN values for the pxyzui array. - pondensi = 0. - else + if (present(use_sink)) then + densi = 1. ! using a value of 0. results in NaN values for the pxyzui array. + pondensi = 0. + else call h2dens(densi,xyzhi,metrici,vi) ! Compute dens from h dens_i = densi ! Feed the newly computed dens back out of the routine call equationofstate(ieos,pondensi,spsoundi,densi,xyzi(1),xyzi(2),xyzi(3),tempi,ui) - endif + endif endif pri = pondensi*densi @@ -238,12 +238,12 @@ subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,eos_vars) !$omp shared(ieos,eos_vars,ien_type) & !$omp private(i,ierr,p_guess,rhoi,tempi,gammai,eni,densi) do i=1,npart - p_guess = 0. - tempi = 0. + p_guess = 0. + tempi = 0. gammai = 0. - rhoi = 1. + rhoi = 1. densi = 1. - ! conservative 2 primitive + ! conservative 2 primitive call conservative2primitive(xyzh(1:3,i),metrics(:,:,:,i),vxyzu(1:3,i),densi,eni, & p_guess,tempi,gammai,rhoi,pxyzu(1:3,i),pxyzu(4,i),ierr,ien_type) @@ -252,12 +252,12 @@ subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,eos_vars) print*,' rho* =',rhoi print*,' en =',eni call fatal('cons2prim','could not solve rootfinding',i) - endif + endif enddo !$omp end parallel do -end subroutine cons2primall_sink +end subroutine cons2primall_sink !----------------------------------------------------------------------------- !+ diff --git a/src/main/energies.F90 b/src/main/energies.F90 index 5d5d69872..b6e29c0d6 100644 --- a/src/main/energies.F90 +++ b/src/main/energies.F90 @@ -73,7 +73,7 @@ subroutine compute_energies(t) isdead_or_accreted,epot_sinksink,imacc,ispinx,ispiny,& ispinz,mhd,gravity,poten,dustfrac,eos_vars,itemp,igasP,ics,& nden_nimhd,eta_nimhd,iion,ndustsmall,graindens,grainsize,& - iamdust,ndusttypes,rad,iradxi,gtgrad,group_info,bin_info,n_group + iamdust,ndusttypes,rad,iradxi,gtgrad,group_info,bin_info,n_group use part, only:pxyzu,fxyzu,fext,apr_level,aprmassoftype,pxyzu_ptmass use gravwaveutils, only:calculate_strain,calc_gravitwaves use centreofmass, only:get_centreofmass_accel @@ -567,7 +567,7 @@ subroutine compute_energies(t) ! if (id==master) then - if (.not. gr) then + if (.not. gr) then !$omp do do i=1,nptmass xi = xyzmh_ptmass(1,i) @@ -612,10 +612,10 @@ subroutine compute_energies(t) endif enddo !$omp enddo - else + else !$omp do do i=1,nptmass - ! calculate Kinetic and thermal energy for the GR-sink case. + ! calculate Kinetic and thermal energy for the GR-sink case. xi = xyzmh_ptmass(1,i) yi = xyzmh_ptmass(2,i) zi = xyzmh_ptmass(3,i) @@ -624,13 +624,13 @@ subroutine compute_energies(t) vxi = vxyz_ptmass(1,i) vyi = vxyz_ptmass(2,i) - vzi = vxyz_ptmass(3,i) + vzi = vxyz_ptmass(3,i) pxi = pxyzu_ptmass(1,i) pyi = pxyzu_ptmass(2,i) pzi = pxyzu_ptmass(3,i) - + mtot = mtot + pmassi call unpack_metric(metrics_ptmass(:,:,:,i),betaUP=beta_gr_UP,alpha=alpha_gr,gammaijdown=gammaijdown) @@ -659,7 +659,7 @@ subroutine compute_energies(t) angx = angx + pmassi*angi(1) angy = angy + pmassi*angi(2) angz = angz + pmassi*angi(3) - + ! rotational energy around each axis through the origin if (calc_erot) then call get_erot(xi,yi,zi,vxi,vyi,vzi,xyzcom,pmassi,erotxi,erotyi,erotzi) @@ -667,9 +667,9 @@ subroutine compute_energies(t) call ev_data_update(ev_data_thread,iev_erot(2),erotyi) call ev_data_update(ev_data_thread,iev_erot(3),erotzi) endif - enddo + enddo !$omp enddo - endif + endif endif !$omp critical(collatedata) diff --git a/src/main/extern_gr.f90 b/src/main/extern_gr.f90 index 166a3b670..cc364c762 100644 --- a/src/main/extern_gr.f90 +++ b/src/main/extern_gr.f90 @@ -67,10 +67,10 @@ subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtexternal real, intent(in) :: xyzh(:,:), metrics(:,:,:,:), metricderivs(:,:,:,:) real, intent(inout) :: vxyzu(:,:) real, intent(out) :: fext(:,:), dtexternal - real, intent(in), optional :: dens(:) + real, intent(in), optional :: dens(:) logical, intent(in), optional :: use_sink ! we pick the data from the xyzh array and assume u=0 for this case integer :: i - real :: dtf,pi,densi + real :: dtf,pi,densi real :: xyzhi(4),vxyzui(4) dtexternal = huge(dtexternal) @@ -80,25 +80,25 @@ subroutine get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtexternal !$omp private(i,dtf,pi,xyzhi,vxyzui,densi) & !$omp reduction(min:dtexternal) do i=1,npart - if (present(use_sink)) then + if (present(use_sink)) then xyzhi(1:3) = xyzh(1:3,i) xyzhi(4) = xyzh(5,i) ! save smoothing length, h vxyzui(1:3) = vxyzu(1:3,i) - vxyzui(4) = 0. + vxyzui(4) = 0. pi = 0. densi = 1. call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzui(1:3),densi,vxyzui(4),pi,fext(1:3,i),dtf) dtexternal = min(dtexternal,C_force*dtf) - else + else if (.not.isdead_or_accreted(xyzh(4,i))) then pi = get_pressure(ieos,xyzh(:,i),dens(i),vxyzu(:,i)) call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pi,fext(1:3,i),dtf) dtexternal = min(dtexternal,C_force*dtf) endif - endif + endif enddo !$omp end parallel do diff --git a/src/main/initial.F90 b/src/main/initial.F90 index a7e79c344..2d59a18d7 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -463,7 +463,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) #endif if (iexternalforce > 0 .and. imetric /= imet_minkowski) then call initialise_externalforces(iexternalforce,ierr) - if (ierr /= 0) call fatal('initial','error in external force settings/initialisation') + if (ierr /= 0) call fatal('initial','error in external force settings/initialisation') call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) endif #else @@ -527,7 +527,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) if (nptmass > 0) then if (id==master) write(iprint,"(a,i12)") ' nptmass = ',nptmass if (iH2R > 0) call update_ionrates(nptmass,xyzmh_ptmass,h_acc) - if (.not. gr) then + if (.not. gr) then ! compute initial sink-sink forces and get timestep if (use_regnbody) then call init_subgroup @@ -536,20 +536,20 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& iexternalforce,time,merge_ij,merge_n,dsdt_ptmass,& group_info,bin_info) - endif + endif #ifdef GR - ! calculate metric derivatives and the external force caused by the metric on the sink particles - ! this will also return the timestep for sink-sink + ! calculate metric derivatives and the external force caused by the metric on the sink particles + ! this will also return the timestep for sink-sink call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& - vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) + vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) ! sinks in GR, provide external force due to metric to determine the sink total force call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& iexternalforce,time,merge_ij,merge_n,dsdt_ptmass) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) -#endif +#endif dtsinksink = C_force*dtsinksink if (id==master) write(iprint,*) 'dt(sink-sink) = ',dtsinksink dtextforce = min(dtextforce,dtsinksink) diff --git a/src/main/ptmass.F90 b/src/main/ptmass.F90 index c20b31c70..c79d97064 100644 --- a/src/main/ptmass.F90 +++ b/src/main/ptmass.F90 @@ -336,7 +336,7 @@ subroutine get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,phitot,dtsinksin #ifdef FINVSQRT use fastmath, only:finvsqrt #endif - use dim, only:gr + use dim, only:gr use externalforces, only:externalforce use extern_geopot, only:get_geopot_force use kernel, only:kernel_softening,radkern diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index f1eacf2bb..5e68c3d26 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -249,7 +249,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) !---------------------------------------------------------------------- call get_timings(t1,tcpu1) if (gr) then - ! first calculate all the force arrays + ! first calculate all the force arrays if (nptmass > 0) then call cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass) @@ -263,7 +263,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzmh_ptmass, & fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fxyz_ptmass,& dsdt_ptmass,fonrmax,dtphi2,bin_info) - enddo + enddo call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) call combine_forces_gr(npart,fext_gas,fext) @@ -271,8 +271,8 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) if ((iexternalforce > 0 .and. imetric /= imet_minkowski) .or. idamp > 0 .or. nptmass > 0 .or. & (nptmass > 0 .and. imetric == imet_minkowski)) then - - ! for now use the minimum of the two timesteps as dtextforce + + ! for now use the minimum of the two timesteps as dtextforce dtextforce = min(dtextforce, C_force*dtsinksink, C_force*sqrt(dtphi2)) call substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t,& xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 08c8f9004..ae0c08291 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -112,7 +112,7 @@ end subroutine substep_sph_gr subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time,& xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) - use dim, only:maxptmass,maxvxyzu,use_apr + use dim, only:maxptmass,maxvxyzu,use_apr use io, only:iverbose,id,master,iprint,warning,fatal use part, only:isdead_or_accreted,iamboundary,igas,iamtype,& massoftype,rhoh,igamma,itemp,igasP @@ -138,7 +138,7 @@ subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,den logical :: last_step,done integer, parameter :: itsmax = 50 integer :: pitsmax,xitsmax - real :: perrmax,xerrmax + real :: perrmax,xerrmax pitsmax = 0 xitsmax = 0 @@ -163,7 +163,7 @@ subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,den nsubsteps = 0 dtextforce_min = huge(dt) done = .false. - + substeps: do while (timei <= t_end_step .and. .not.done) hdt = 0.5*dt timei = timei + dt @@ -175,14 +175,14 @@ subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,den if (.not.last_step .and. iverbose > 1 .and. id==master) then write(iprint,"(a,f14.6)") '> external forces only : t=',timei endif - + call predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & dens,metrics,metricderivs,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,pitsmax,perrmax, & xitsmax,xerrmax,dtextforcenew) - + if (iverbose >= 2 .and. id==master) then write(iprint,*) '------ Iterations summary: -------------------------------' write(iprint,"(a,i2,a,f14.6)") 'Most pmom iterations = ',pitsmax,' | max error = ',perrmax @@ -197,7 +197,7 @@ subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,den naccreted = 0 nlive = 0 dtextforce_min = bignumber - + call accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& pxyzu,accretedmass,hdt,npart,nptmass,& ntypes,dtextforce_min,timei,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& @@ -1069,9 +1069,9 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & dens,metrics,metricderivs,& xyzh_ptmass,vxyz_ptmass,fxyz_ptmass,& metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& - pitsmax,perrmax,& + pitsmax,perrmax,& xitsmax,xerrmax,dtextforcenew) - + use dim, only:maxptmass,maxp,maxvxyzu,use_apr use io, only:master,warning,fatal use externalforces, only:externalforce,accrete_particles,update_externalforce @@ -1109,7 +1109,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & real :: rhoi,hi,eni,uui,densi,poti real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) real :: dtphi2,dtsinksink,fonrmax - integer :: merge_ij(nptmass),merge_n + integer :: merge_ij(nptmass),merge_n real :: fext_gas(4,npart),fext_sinks(4,nptmass) pmassi = massoftype(igas) @@ -1159,7 +1159,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & elseif (use_apr) then pmassi = aprmassoftype(igas,apr_level(i)) endif - + its = 0 converged = .false. ! @@ -1185,7 +1185,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & pmom_iterations: do while (its <= itsmax .and. .not. converged) its = its + 1 pprev = pxyz - ! calculate force between sink-gas particles + ! calculate force between sink-gas particles call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzh_ptmass, & fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_sinks,& dsdt_ptmass,fonrmax,dtphi2,bin_info) @@ -1260,7 +1260,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & call predict_gr_sink(xyzh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fext_sinks,nptmass,& dt,timei,hdt,metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax,& xitsmax,xerrmax) - + end subroutine predict_gr !---------------------------------------------------------------- @@ -1270,7 +1270,7 @@ end subroutine predict_gr !---------------------------------------------------------------- subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fext_sinks,nptmass,dt,timei,hdt, & metrics,metricderivs,dtextforcenew,pitsmax,perrmax, & - xitsmax,xerrmax) + xitsmax,xerrmax) use dim, only:maxptmass,maxp,maxvxyzu use io, only:master,warning,fatal use externalforces, only:externalforce,accrete_particles,update_externalforce @@ -1304,7 +1304,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex ! real, save :: dmdt = 0. logical :: converged real :: rhoi,hi,eni,uui,densi - integer :: merge_ij(2),merge_n + integer :: merge_ij(2),merge_n real :: dtsinksink !--------------------------- @@ -1323,7 +1323,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex !$omp private(converged,pmom_err,x_err,pri,ierr,gammai,pmassi) & !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & !$omp reduction(min:dtextforcenew) - + predictor: do i=1,nptmass xyzhi(1) = xyzmh_ptmass(1,i) xyzhi(2) = xyzmh_ptmass(2,i) @@ -1424,7 +1424,7 @@ end subroutine predict_gr_sink !---------------------------------------------------------------- !+ - ! routine for accretion step in GR case + ! routine for accretion step in GR case !+ !---------------------------------------------------------------- subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& @@ -1450,16 +1450,16 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, use ptmass, only:get_accel_sink_sink,get_accel_sink_gas real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:) integer, intent(in) :: npart,ntypes,nptmass - integer, intent(inout) :: nlive,naccreted - integer, intent(inout) :: nlive_sinks,naccreted_sinks + integer, intent(inout) :: nlive,naccreted + integer, intent(inout) :: nlive_sinks,naccreted_sinks real, intent(inout) :: accretedmass real, intent(in) :: hdt,timei real, intent(inout) :: dtextforce_min - logical :: accreted + logical :: accreted integer :: i,itype real :: pmassi real :: dtf @@ -1469,7 +1469,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, integer, parameter :: itsmax = 50 real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) real :: dtphi2,dtsinksink,fonrmax,poti - integer :: merge_ij(nptmass),merge_n + integer :: merge_ij(nptmass),merge_n real :: fext_gas(4,npart),fext_sinks(4,nptmass) pmassi = massoftype(igas) @@ -1512,7 +1512,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, ! if (itype==iboundary) cycle accreteloop elseif (use_apr) then pmassi = aprmassoftype(igas,apr_level(i)) - endif + endif call equationofstate(ieos,pondensi,spsoundi,dens(i),xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi,vxyzu(4,i)) pri = pondensi*dens(i) @@ -1552,11 +1552,11 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fext_sinks,& metrics_ptmass,metricderivs_ptmass,nlive_sinks,naccreted_sinks,pxyzu_ptmass,& accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) - end subroutine accrete_gr + end subroutine accrete_gr !---------------------------------------------------------------- !+ - ! routine for accretion step in GR case + ! routine for accretion step in GR case !+ !---------------------------------------------------------------- subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptmass,metricderivs_ptmass,& @@ -1576,13 +1576,13 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptma real, intent(in) :: hdt,timei,dtsinksink real, intent(inout) :: dtextforce_min - logical :: accreted + logical :: accreted integer :: i real :: xyzhi(4),pmassi,densi,pri real :: dtf,hsofti ! real, save :: dmdt = 0. integer, parameter :: itsmax = 50 - + !$omp parallel default(none) & !$omp shared(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,vxyz_ptmass,fext,hdt,timei) & !$omp shared(dtsinksink,fext_sinks) & @@ -1590,13 +1590,13 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptma !$omp shared(pxyzu_ptmass,iexternalforce,C_force) & !$omp private(dtf,xyzhi,hsofti,pmassi,pri,densi) & !$omp reduction(min:dtextforce_min) & - !$omp reduction(+:accretedmass,naccreted_sinks,nlive_sinks) + !$omp reduction(+:accretedmass,naccreted_sinks,nlive_sinks) !$omp do accreteloop: do i=1,nptmass pri = 0. densi = 1. - - ! add this force due to the curvature of the metric. + + ! add this force due to the curvature of the metric. xyzhi(1:3) = xyzmh_ptmass(1:3,i) ! if a sink particle is already eaten by the black hole, skip it... @@ -1641,20 +1641,20 @@ end subroutine accrete_gr_sink subroutine combine_forces_gr(nptmass,fsinks,fgr) real, intent(in) :: fsinks(:,:) - integer, intent(in) :: nptmass + integer, intent(in) :: nptmass real, intent(inout) :: fgr(:,:) - integer :: i + integer :: i - do i=1,nptmass - fgr(:,i) = fsinks(:,i) + fgr(:,i) - enddo + do i=1,nptmass + fgr(:,i) = fsinks(:,i) + fgr(:,i) + enddo end subroutine combine_forces_gr subroutine combine_forces_gr_one(fsink,fgr) - real, intent(in) :: fsink(:) + real, intent(in) :: fsink(:) real, intent(inout) :: fgr(:) fgr(:) = fgr(:) + fsink(:) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 329789aac..a72cb2b41 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -128,7 +128,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, ! mhole = 1.e6 ! (solar masses) if (gr) then - call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set umass as 1e6*msun + call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set umass as 1e6*msun else call set_units(mass=solarm,dist=solarr,G=1.d0) endif @@ -146,12 +146,12 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, use_var_comp = .false. relax = .true. - if (nstar > 1) then + if (nstar > 1) then call set_defaults_stars(star) call set_defaults_orbit(orbit) - else + else call set_defaults_star(star(1)) - endif + endif ! !-- Read runtime parameters from setup file ! @@ -166,62 +166,62 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, endif stop endif - ! - !--set nstar/nptmass stars around the BH. This would also relax the star. - ! + ! + !--set nstar/nptmass stars around the BH. This would also relax the star. + ! call set_stars(id,master,nstar,star,xyzh,vxyzu,eos_vars,rad,npart,npartoftype,& massoftype,hfact,xyzmh_ptmass,vxyz_ptmass,nptmass,ieos,polyk,gamma,& X_in,Z_in,relax,use_var_comp,write_profile,& rhozero,npart_total,i_belong,ierr) - - if (star(1)%iprofile == 0 .and. nstar == 1) then - xyzmh_ptmass_in(4,1) = star(1)%mstar + + if (star(1)%iprofile == 0 .and. nstar == 1) then + xyzmh_ptmass_in(4,1) = star(1)%mstar xyzmh_ptmass_in(5,1) = star(1)%hacc - - endif - ! + endif + + ! !--set the stars around each other first if nstar > 1 (Assuming binary system) ! - if (nstar > 1 .and. (.not. provide_params)) then + if (nstar > 1 .and. (.not. provide_params)) then nptmass_in = 0 call set_orbit(orbit,star(1)%mstar,star(2)%mstar,star(1)%hacc,star(2)%hacc,& xyzmh_ptmass_in,vxyz_ptmass_in,nptmass_in,(id==master),ierr) if (ierr /= 0) call fatal ('setup_binary','error in call to set_orbit') if (ierr /= 0) call fatal('setup','errors in set_star') - endif - + endif + ! !--place star / stars into orbit ! ! Calculate tidal radius - if (nstar == 1) then - ! for single star around the BH, the tidal radius is given by + if (nstar == 1) then + ! for single star around the BH, the tidal radius is given by ! RT = rr * (MM / mm)**(1/3) where rr is rstar, MM is mass of BH and mm is mass of star rtidal = star(1)%rstar * (mass1/star(1)%mstar)**(1./3.) rp = rtidal/beta - else + else semi_major_axis_str = orbit%elems%semi_major_axis read(semi_major_axis_str, *, iostat=ios) semi_maj_val - ! for a binary, tidal radius is given by - ! orbit.an * (3 * MM / mm)**(1/3) where mm is mass of binary and orbit.an is semi-major axis of binary + ! for a binary, tidal radius is given by + ! orbit.an * (3 * MM / mm)**(1/3) where mm is mass of binary and orbit.an is semi-major axis of binary rtidal = semi_maj_val * (3.*mass1 / (star(1)%mstar + star(2)%mstar))**(1./3.) rp = rtidal/beta - endif + endif - if (gr) then + if (gr) then accradius1_hard = 5.*mass1 accradius1 = accradius1_hard - else - if (mass1 /= 0.) then + else + if (mass1 /= 0.) then accradius1_hard = 6. accradius1 = accradius1_hard - endif + endif endif a = 0. theta_bh = theta_bh*pi/180. - + print*, 'umass', umass print*, 'udist', udist print*, 'uvel', unit_velocity @@ -230,11 +230,11 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, print*, 'beta', beta print*, accradius1_hard, "accradius1_hard",mass1,"mass1" - if (.not. provide_params) then + if (.not. provide_params) then do i = 1, nstar print*, 'mstar of star ',i,' is: ', star(i)%mstar print*, 'rstar of star ',i,' is: ', star(i)%rstar - enddo + enddo xyzstar = 0. vxyzstar = 0. @@ -284,7 +284,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, tmax = norbits*period dtmax = period/dumpsperorbit - endif + endif if (id==master) then print "(/,a)", ' STAR SETUP:' @@ -295,24 +295,24 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, print "(a,3f10.3,/)",' Pericentre = ',rp endif ! - !--shift stars / sink particles + !--shift stars / sink particles ! - if (provide_params) then + if (provide_params) then xyzmh_ptmass_in(1:3,1) = (/x1,y1,z1/) xyzmh_ptmass_in(1:3,2) = (/x2,y2,z2/) vxyz_ptmass_in(:,1) = (/vx1, vy1, vz1/) vxyz_ptmass_in(:,2) = (/vx2, vy2, vz2/) - xyzmh_ptmass_in(4,1) = star(1)%mstar + xyzmh_ptmass_in(4,1) = star(1)%mstar xyzmh_ptmass_in(5,1) = star(1)%hacc xyzmh_ptmass_in(4,2) = star(2)%mstar - xyzmh_ptmass_in(5,2) = star(2)%hacc + xyzmh_ptmass_in(5,2) = star(2)%hacc else - do i = 1, nstar + do i = 1, nstar xyzmh_ptmass_in(1:3,i) = xyzmh_ptmass_in(1:3,i) + xyzstar(:) vxyz_ptmass_in(1:3,i) = vxyz_ptmass_in(1:3,i) + vxyzstar(:) - enddo + enddo endif call shift_stars(nstar,star,xyzmh_ptmass_in,vxyz_ptmass_in,& @@ -332,7 +332,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, endif if (.not.gr) iexternalforce = 1 - ! We have ignored the following error message. + ! We have ignored the following error message. !if (npart == 0) call fatal('setup','no particles setup') if (ierr /= 0) call fatal('setup','ERROR during setup') @@ -355,32 +355,32 @@ subroutine write_setupfile(filename) call write_inopt(provide_params,'provide_params','initial conditions',iunit) call write_inopt(nstar, 'nstar', 'number of stars to set',iunit) - if (nstar /= 0) then - if (nstar == 1) then + if (nstar /= 0) then + if (nstar == 1) then call write_options_star(star(1),iunit) call write_inopt(relax,'relax','relax star into hydrostatic equilibrium',iunit) - if (relax) call write_options_relax(iunit) - else + if (relax) call write_options_relax(iunit) + else call write_options_stars(star,relax,iunit) - endif + endif write(iunit,"(/,a)") '# options for black hole and orbit' call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)',iunit) - if (.not. provide_params) then + if (.not. provide_params) then call write_inopt(beta, 'beta', 'penetration factor', iunit) call write_inopt(ecc_bh, 'ecc_bh', 'eccentricity (1 for parabolic)', iunit) call write_inopt(norbits, 'norbits', 'number of orbits', iunit) call write_inopt(dumpsperorbit,'dumpsperorbit','number of dumps per orbit', iunit) call write_inopt(theta_bh, 'theta_bh', 'inclination of orbit (degrees)', iunit) - if (nstar > 1) then + if (nstar > 1) then call write_options_orbit(orbit,iunit) - endif - else + endif + else write(iunit,"(/,a)") '# provide inputs for the binary system' call write_params(iunit) - endif - endif + endif + endif close(iunit) end subroutine write_setupfile @@ -412,36 +412,36 @@ subroutine read_setupfile(filename,ieos,polyk,mass1,ierr) call read_inopt(provide_params,'provide_params',db,errcount=nerr) call read_inopt(mhole,'mhole',db,min=0.,errcount=nerr) ! call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set central mass to M=1 in code units - ! This ensures that we can run simulations with BH's as massive as 1e9 msun. - ! A BH of mass 1e9 msun would be 1e3 in code units when umass is 1e6*solar masses. + ! This ensures that we can run simulations with BH's as massive as 1e9 msun. + ! A BH of mass 1e9 msun would be 1e3 in code units when umass is 1e6*solar masses. mass1 = mhole*solarm/umass call read_inopt(nstar, 'nstar', db,min=0,errcount=nerr) ! !--read star options and convert to code units ! - if (nstar /= 0) then - if (nstar == 1) then + if (nstar /= 0) then + if (nstar == 1) then call read_options_star(star(1),need_iso,ieos,polyk,db,nerr) call read_inopt(relax,'relax',db,errcount=nerr) if (relax) call read_options_relax(db,nerr) - else + else call read_options_stars(star,need_iso,ieos,polyk,relax,db,nerr) - endif + endif - if (.not. provide_params) then + if (.not. provide_params) then call read_inopt(beta, 'beta', db,min=0.,errcount=nerr) call read_inopt(ecc_bh, 'ecc_bh', db,min=0.,max=1.,errcount=nerr) call read_inopt(norbits, 'norbits', db,min=0.,errcount=nerr) call read_inopt(dumpsperorbit, 'dumpsperorbit', db,min=0 ,errcount=nerr) call read_inopt(theta_bh, 'theta_bh', db, errcount=nerr) - if (nstar > 1) then + if (nstar > 1) then call read_options_orbit(orbit,db,nerr) - endif - else + endif + else call read_params(db,nerr) - endif + endif - endif + endif call close_db(db) if (nerr > 0) then print "(1x,i2,a)",nerr,' error(s) during read of setup file: re-writing...' @@ -453,7 +453,7 @@ end subroutine read_setupfile subroutine write_params(iunit) use infile_utils, only:write_inopt integer, intent(in) :: iunit - + call write_inopt(x1, 'x1', 'pos x star 1', iunit) call write_inopt(y1, 'y1', 'pos y star 1', iunit) call write_inopt(z1, 'z1', 'pos z star 1', iunit) diff --git a/src/setup/setup_windtunnel.f90 b/src/setup/setup_windtunnel.f90 index 842198d12..d92faff17 100644 --- a/src/setup/setup_windtunnel.f90 +++ b/src/setup/setup_windtunnel.f90 @@ -170,7 +170,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, deallocate(r,den,pres) endif - + print*, "udist = ", udist, "; umass = ", umass, "; utime = ", utime end subroutine setpart diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 7b07370ba..61796ab9f 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -63,7 +63,7 @@ subroutine test_ptmass(ntests,npass,string) case('ptmassbinary') do_test_binary = .true. case('ptmassgenrel') - do_test_binary_gr = .true. + do_test_binary_gr = .true. case('ptmassaccrete') do_test_accretion = .true. case('ptmasscreatesink') @@ -129,7 +129,7 @@ subroutine test_ptmass(ntests,npass,string) ! ! Test for sink particles in GR ! - if (do_test_binary_gr .or. testall) call test_sink_binary_gr(ntests,npass,string) + if (do_test_binary_gr .or. testall) call test_sink_binary_gr(ntests,npass,string) ! ! Test of sink particle potentials ! @@ -459,12 +459,12 @@ subroutine test_binary(ntests,npass,string) end subroutine test_binary !----------------------------------------------------------------------- -!+ -! Test that binary setup in GR using sink particles is OK. +!+ +! Test that binary setup in GR using sink particles is OK. !+ !----------------------------------------------------------------------- subroutine test_sink_binary_gr(ntests,npass,string) - use io, only:id,master,iverbose + use io, only:id,master,iverbose use part, only:init_part,npart,npartoftype,nptmass,xyzmh_ptmass,vxyz_ptmass,& epot_sinksink,metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& fxyz_ptmass,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,& @@ -497,7 +497,7 @@ subroutine test_sink_binary_gr(ntests,npass,string) ! call init_part() ! - !--set quantities + !--set quantities ! npartoftype = 0 npart = 0 @@ -505,46 +505,46 @@ subroutine test_sink_binary_gr(ntests,npass,string) m1 = 1.e-6 m2 = 1.e-6 a = 2.35 ! udist in GR is 1.48E+11. 5 Rsun in code units - ecc = 0. ! eccentricity of binary orbit - hacc1 = 0.75 ! 0.35 rsun in code units - hacc2 = 0.75 - mass1 = 0. ! set BH mass as 0. So the metric becomes Minkowski - t = 0. + ecc = 0. ! eccentricity of binary orbit + hacc1 = 0.75 ! 0.35 rsun in code units + hacc2 = 0.75 + mass1 = 0. ! set BH mass as 0. So the metric becomes Minkowski + t = 0. iverbose = 0 ! chose a very small value because a value of 0.35 was resulting in distance - distance_init of 1.e-3 - ! but using a small timestep resulted in values smaller than equal to 1.e-4 + ! but using a small timestep resulted in values smaller than equal to 1.e-4 C_force = 0.25 tol = epsilon(0.) omega = sqrt((m1+m2)/a**3) vphi = a*omega - ! set sinks around each other + ! set sinks around each other call set_units(mass=1.e6*solarm,c=1.d0,G=1.d0) call set_binary(m1,m2,a,ecc,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,verbose=.false.) dis = norm2(xyzmh_ptmass(1:3,1) - xyzmh_ptmass(1:3,2)) if (ierr /= 0) nerr = nerr + 1 - ! check the setup is ok + ! check the setup is ok nfailed = 0 call check_setup(nerr,nwarn) call checkval(nerr,0,0,nfailed(1),'no errors during setting sink binary orbit') - call update_test_scores(ntests,nfailed,npass) + call update_test_scores(ntests,nfailed,npass) ! - !--initialise forces and test that the curvature contribution is 0. when mass1 is 0. + !--initialise forces and test that the curvature contribution is 0. when mass1 is 0. ! if (id==master) then call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& - vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) + vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) ! sinks in GR, provide external force due to metric to determine the sink total force call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_sinksink,epot_sinksink,& dtsinksink,0,0.,merge_ij,merge_n,dsdt_sinksink) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) call combine_forces_gr(nptmass,fxyz_sinksink,fxyz_ptmass) - - ! Test the force calculated is same as sink-sink because there is no curvature. + + ! Test the force calculated is same as sink-sink because there is no curvature. call checkval(fxyz_sinksink(1,1), fxyz_ptmass(1,1),tol,nfailed(1),'x force term for sink 1') call checkval(fxyz_sinksink(2,1), fxyz_ptmass(2,1),tol,nfailed(2),'y force term for sink 1') @@ -594,19 +594,19 @@ subroutine test_sink_binary_gr(ntests,npass,string) do i=1,nsteps dtsph = dt call substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,t,& - xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) + xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) call compute_energies(t) errmax = max(errmax,abs(etot - etotin)) - t = t + dt + t = t + dt dis = norm2(xyzmh_ptmass(1:3,1) - xyzmh_ptmass(1:3,2)) - enddo + enddo ! - !--check the radius of the orbit does not change + !--check the radius of the orbit does not change ! call checkval(dis,a,7.e-4,nfailed(1),"radius of orbit") call update_test_scores(ntests,nfailed,npass) ! - !--check energy, linear and angular momentum conservation + !--check energy, linear and angular momentum conservation ! tol_en = 1.e-13 call compute_energies(t) diff --git a/src/utils/analysis_common_envelope.f90 b/src/utils/analysis_common_envelope.f90 index 1041d4e04..227a329eb 100644 --- a/src/utils/analysis_common_envelope.f90 +++ b/src/utils/analysis_common_envelope.f90 @@ -1371,7 +1371,7 @@ subroutine output_extra_quantities(time,dumpfile,npart,particlemass,xyzh,vxyzu) .or. quants==9 .or. quants==10 .or. quants==13) req_gas_energy = any(quants==1 .or. quants==2 .or. quants==3) req_thermal_energy = any(quants==1 .or. quants==3) - + if (any(quants==6 .or. quants==8)) then sinkcom_xyz = (xyzmh_ptmass(1:3,1)*xyzmh_ptmass(4,1) + xyzmh_ptmass(1:3,2)*xyzmh_ptmass(4,2)) & / (xyzmh_ptmass(4,1) + xyzmh_ptmass(4,2)) @@ -1386,7 +1386,7 @@ subroutine output_extra_quantities(time,dumpfile,npart,particlemass,xyzh,vxyzu) endif if (any(quants==10) .and. dump_number==0) allocate(init_entropy(npart)) - + if (any(quants==13)) call set_abundances ! set initial abundances to get mass_per_H @@ -1852,7 +1852,7 @@ subroutine recombination_tau(time,npart,particlemass,xyzh,vxyzu) kappa_part(i) = kappa ! In cgs units call ionisation_fraction(rho_part(i)*unit_density,eos_vars(itemp,i),X_in,1.-X_in-Z_in,xh0,xh1,xhe0,xhe1,xhe2) call calc_gas_energies(particlemass,poten(i),xyzh(:,i),vxyzu(:,i),rad(:,i),xyzmh_ptmass,phii,& - epoti,ekini,egasi,eradi,ereci,dum) + epoti,ekini,egasi,eradi,ereci,dum) call calc_thermal_energy(particlemass,ieos,xyzh(:,i),vxyzu(:,i),ponrhoi*rho_part(i),eos_vars(itemp,i),ethi) etoti = ekini + epoti + ethi if ((xh0 > recomb_th) .and. (.not. prev_recombined(i)) .and. (etoti < 0.)) then ! Recombination event and particle is still bound @@ -3777,7 +3777,7 @@ subroutine calc_gas_energies(particlemass,poten,xyzh,vxyzu,rad,xyzmh_ptmass,phii egasi = vxyzu(4)*particlemass egasradi = egasi + eradi case(10) ! not tested - eradi = 0. ! not implemented + eradi = 0. ! not implemented egasi = 0. ! not implemented call equationofstate(ieos,ponrhoi,spsoundi,rhoi,xyzh(1),xyzh(2),xyzh(3),tempi,vxyzu(4)) presi = ponrhoi*rhoi diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index e132f4f67..9b9511df8 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -147,13 +147,13 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid real :: tot_rem_mass,pos_com(3),vel_com(3),pos_com_mag,vel_com_mag integer :: index_sort,double_count real,allocatable :: pos_wrt_bh(:,:),vel_wrt_bh(:,:),interp_comp_npart(:,:) - real :: vphi_i,R_mag_i,vphi_sum,R_vec(2),vphi_avg,omega_vec(3),rad_cyl,breakup + real :: vphi_i,R_mag_i,vphi_sum,R_vec(2),vphi_avg,omega_vec(3),rad_cyl,breakup ! use adiabatic EOS ieos = 2 call init_eos(ieos,ierr) gmw=0.61 - ! Set mass of black hole in code units + ! Set mass of black hole in code units bhmass = 1 ! Set initial cut based on temperature as zero K temp_cut = 0. @@ -237,7 +237,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid 'index_sort' - + ! this will determine when sorted indices are part of the star. We would also need the normal i indicies of the sorted particles ! Using this we can determine which sorted particles are part of the array and then use the sorted information to calculate all the ! quantities we require for the project @@ -248,7 +248,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid write(10,"(2(a22,1x))") & "rad",& "vphi" - + write(output,"(a4,i5.5)") 'vbra',numfile open(111,file=output) write(111,"(2(a22,1x))") & @@ -286,8 +286,8 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid ke_i = ke_npart(j) pe_i = pe_npart(i) write(14,*) i,j,pos_i,vel_i,pos_vec_i(1)*udist,pos_vec_i(2)*udist,pos_vec_i(3)*udist,temperature_i,density_i*unit_density,sorted_index(i) - - ! Calculate the angular velocity in cylindrical coordinates + + ! Calculate the angular velocity in cylindrical coordinates vphi_i = vel_vec_i(1)*(-pos_vec_i(2)/R_mag_i) + vel_vec_i(2)*(pos_vec_i(1)/R_mag_i) vphi_i = vphi_i/R_mag_i @@ -316,12 +316,12 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid L_i(:) = Li(:)*pmass ! Moment of Inertia Matrix call moment_of_inertia(pos_vec_i,pos_i,pmass,i_matrix) - + if (pos_i == 0.) then omega_particle = 0. else omega_vec(:) = Li(:)/pos_i**2 - omega_particle = norm2(omega_vec) + omega_particle = norm2(omega_vec) endif breakup = ((gg*i*pmass*umass)/(pos_i*udist)**3)**(0.5) write(11,*) pos_i,omega_particle/utime,vphi_i/utime,pos_vec_i(1),pos_vec_i(2),pos_vec_i(3) @@ -340,7 +340,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid breakup,& j,& index_sort - + write(41,'(6(e18.10,1x))') & pos_vec_i(1), & pos_vec_i(2), & @@ -356,7 +356,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid endif ! Calculate how many particles will go in a bin call no_per_bin(i,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner,double_count) - + ! We sum the quantities we want to save for the particles density_sum = density_sum + density_i temperature_sum = temperature_sum + temperature_i @@ -370,21 +370,21 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid ! We check id the count_particles is the same as the number_per_bin ! If true then we save the bin information !if (count_particles==number_per_bin .or. i==energy_verified_no) then - if (count_particles==number_per_bin) then + if (count_particles==number_per_bin) then ! Total particles binned. Should be the same as energy_verified_no at the end tot_binned_particles = tot_binned_particles+count_particles ! Calculate the bin quantities call radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy_verified_no,pos_npart,radius_star,pos_vec_npart,rad_cyl) - + rad_grid(ibin) = radius_star density(ibin) = density_sum/count_particles mass_enclosed(ibin) = tot_binned_particles*pmass bin_mass(ibin) = count_particles*pmass ! Change the temperature of particles if its < 1.e3 to 1.e3 - if (temperature_sum < 1.e3) then + if (temperature_sum < 1.e3) then print*,"THIS BIN HAS TEMP LESS THAN 1000 K",temperature_sum - endif + endif temperature(ibin) = max(temperature_sum/count_particles,1e3) rad_vel(ibin) = rad_mom_sum/bin_mass(ibin) !Radial vel of each bin is summation(vel_rad_i*m_i)/summation(m_i) if (count_particles == 1) then @@ -409,7 +409,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid write(10,*) udist*rad_grid(ibin),norm2(angular_vel_3D(:,ibin))/utime write(111,*) udist*rad_grid(ibin),breakup endif - + !print*,count_particles,"count particles",ibin,"ibin",rad_grid(ibin),"rad",number_per_bin,"number per bin" ! Reset the sum values count_particles = 0 @@ -421,7 +421,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid composition_sum(:) = 0. vphi_sum = 0. ibin = ibin+1 - number_per_bin = big_bins_no + number_per_bin = big_bins_no endif enddo close(111) @@ -438,7 +438,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid ! Get the COM pos and vel magnitudes call determine_pos_vel_com(vel_com,pos_com,pos_com_mag,vel_com_mag,tot_rem_mass) - print*,pos_i,"Radius of last particle in code units" + print*,pos_i,"Radius of last particle in code units" print*,pos_com,"POS COM",vel_com,"VEL COM" print*,xpos,"XPOS",vpos,"VPOS",mass_enclosed(ibin)*umass,"mass" print*,norm2(xpos),norm2(pos_com),"pos mag",norm2(pos_com)/170.33676805,"how far from rt?" @@ -495,7 +495,7 @@ subroutine determine_bound_unbound(vel_com,pos_com,pos_com_mag,vel_com_mag,bhmas pe_star = -gg*bhmass_cgs/(pos_com_mag*udist) tot_energy_remnant_com = ke_star + pe_star print*,vel_com_cgs,"CGS vel com",pos_com_cgs,"CGS pos com" - + if (tot_energy_remnant_com < 0.) then print*, "REMNANT IS BOUND TO THE BLACKHOLE",tot_energy_remnant_com,"energy val" call determine_orbital_params(rem_mass,bhmass_cgs,pos_com_cgs,vel_com_cgs,period_val) @@ -503,7 +503,7 @@ subroutine determine_bound_unbound(vel_com,pos_com,pos_com_mag,vel_com_mag,bhmas er = 1 - (56.77892268*udist)/ar print*,"******************" print*,ar/1.496e13,"ar",er,"er" - elseif (tot_energy_remnant_com == 0.) then + elseif (tot_energy_remnant_com == 0.) then print*, "Parabolic orbit!" else print*, "REMNANT IS UNBOUND" @@ -527,7 +527,7 @@ subroutine determine_orbital_params(rem_mass,bhmass_cgs,pos_com,vel_com,period_v use orbits_data, only : escape,semimajor_axis,period_star,eccentricity_star real,intent(in) :: rem_mass,bhmass_cgs,pos_com(3),vel_com(3) real,intent(out):: period_val - real :: ecc_val + real :: ecc_val ecc_val = eccentricity_star(rem_mass,bhmass_cgs,pos_com,vel_com) print*,ecc_val,"ECCENTRICITY VALUE!!!!",rem_mass,"rem mass", bhmass_cgs,"bhmass cgs",pos_com,"com pos",vel_com,"com vel" @@ -615,7 +615,7 @@ subroutine particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sort allocate(temp_bound(energy_verified_no), index_bound_sorted(energy_verified_no),index_bound_new(energy_verified_no)) do i = 1,energy_verified_no temp_bound(i) = temp_particles(i) - ! This is the sorted index + ! This is the sorted index index_bound_sorted(i) = index_particle_star(i) index_bound_new(i) = index_bound(i) enddo @@ -634,11 +634,11 @@ subroutine particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sort ! use temp_cut to ignore the streams do i = 1,energy_verified_no if (temp_bound(i) > temp_cut) then - bound_particles_no = bound_particles_no + 1 + bound_particles_no = bound_particles_no + 1 ! Save the sorted array indices only bound_index(bound_particles_no) = index_bound_new(i) sorted_index(bound_particles_no) = index_bound_sorted(i) - if (sorted_index(bound_particles_no) == 13) then + if (sorted_index(bound_particles_no) == 13) then print*, bound_index(bound_particles_no),"bound_index(bound_particles_no)" endif endif @@ -733,7 +733,7 @@ subroutine radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy integer :: index_val_next,index_val real :: pos_cyl,pos_cyl_next real :: pos_cyl_vec(3),pos_cyl_vec_next(3) - + index_val = bound_index(i) index_val_next = bound_index(i+1) pos_mag = pos_npart(index_val) @@ -742,7 +742,7 @@ subroutine radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy if (count_particles == number_per_bin .and. i /= energy_verified_no) then pos_mag_next = pos_npart(index_val_next) pos_cyl_vec_next(:) = pos_vec_npart(:,index_val_next) - + radius_star = (pos_mag+pos_mag_next)/2 pos_cyl_next = sqrt(pos_cyl_vec_next(1)**2 + pos_cyl_vec_next(2)**2) rad_cyl = (pos_cyl + pos_cyl_next)/2 @@ -868,7 +868,7 @@ subroutine calculate_npart_quantities(npart,iorder,numfile,xyzh,vxyzu,pmass,xpos pos_wrt_bh(:,j) = xyzh(1:3,i) vel_wrt_bh(:,j) = vxyzu(1:3,i) h_npart(j) = xyzh(4,i) - + interp_comp_npart(:,j) = interpolate_comp(:,i) enddo @@ -1237,7 +1237,7 @@ subroutine calculate_temp_cut(temperature_array,count_bound,temp_cut,max_temp,te endif enddo enddo - + print*,"***-------------------------------------" print*,temp_array_new,"TEMP ARRAY",size(temp_array_new) print*,count_particles_temp,"COUNT PARTICLES TEMP",size(count_particles_temp) @@ -1270,9 +1270,9 @@ subroutine calculate_temp_cut(temperature_array,count_bound,temp_cut,max_temp,te exit endif enddo - + !print*,count_cut_index,"final cut index" - + ! Define the temperature to cut the model at temp_cut = temp_array_new(count_cut_index) From 99f191741201201409a4f23a4f30af071bf34e63 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:44:27 +1100 Subject: [PATCH 35/54] [author-bot] updated AUTHORS file --- AUTHORS | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/AUTHORS b/AUTHORS index 78279c152..b7745260b 100644 --- a/AUTHORS +++ b/AUTHORS @@ -13,8 +13,8 @@ David Liptai Lionel Siess Fangyi (Fitz) Hu Yann Bernard -Daniel Mentiplay Megha Sharma +Daniel Mentiplay Arnaud Vericel Mark Hutchison Mats Esseldeurs @@ -60,6 +60,7 @@ Benoit Commercon Christopher Russell Giulia Ballabio Joe Fisher +Kateryna Andrych Maxime Lombart Orsola De Marco Shunquan Huang From d838f74c518ec6a5a4fa35e31c285d18717d5e11 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:44:35 +1100 Subject: [PATCH 36/54] [format-bot] end if -> endif; end do -> enddo; if( -> if ( --- src/setup/setup_grtde.f90 | 2 +- src/utils/analysis_kepler.f90 | 20 ++++++++++---------- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index a72cb2b41..b0c94fff4 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -203,7 +203,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, rp = rtidal/beta else semi_major_axis_str = orbit%elems%semi_major_axis - read(semi_major_axis_str, *, iostat=ios) semi_maj_val + read(semi_major_axis_str, *,iostat=ios) semi_maj_val ! for a binary, tidal radius is given by ! orbit.an * (3 * MM / mm)**(1/3) where mm is mass of binary and orbit.an is semi-major axis of binary rtidal = semi_maj_val * (3.*mass1 / (star(1)%mstar + star(2)%mstar))**(1./3.) diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index 9b9511df8..24a22e97e 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -595,7 +595,7 @@ subroutine particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sort temp_found = .false. energy_verified_no = 0 allocate(index_particle_star(npart),index_bound(npart),temp_particles(npart)) - open(unit=10, file="particle_index_clean") + open(unit=10,file="particle_index_clean") ! Use the sorted array information and check the energy condition first do i=1,npart !if energy is less than 0, we have bound system. We can accept these particles. @@ -687,11 +687,11 @@ subroutine no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no avg_val = (pos_mag_next+rad_inner)/2 diff_val = (pos_mag_next-rad_inner) - open(15,file="rad_to_bin",status='old', action='write', iostat=i) + open(15,file="rad_to_bin",status='old',action='write',iostat=i) if (i /= 0) then ! File does not exist, create it - open(unit=15, file="rad_to_bin", status='new', action='write', iostat=i) - end if + open(unit=15,file="rad_to_bin",status='new',action='write',iostat=i) + endif if (j==1) then number_per_bin = 1 @@ -916,16 +916,16 @@ subroutine composition_array(interpolate_comp,columns_compo,comp_label) !Save composition read from file. allocate(interpolate_comp(columns_compo,n_rows)) - open(12, file=filename) + open(12,file=filename) ierr = 0 !get column labels and send them back. - read(12, '(a)', iostat=ierr) line + read(12, '(a)',iostat=ierr) line allocate(comp_label(columns_compo)) call get_column_labels(line,n_labels,comp_label) close(12) print*,"comp_label ",comp_label - open(13, file=filename) + open(13,file=filename) call skip_header(13,nheader,ierr) do k = 1, n_rows read(13,*,iostat=ierr) interpolate_comp(:,k) @@ -1094,14 +1094,14 @@ subroutine write_dump_info(fileno,density,temperature,mass,xpos,rad,distance,pos ! open the file for appending or creating if (file_exists) then - open(unit=file_id, file=filename, status='old', position="append", action="write", iostat=status) + open(unit=file_id,file=filename,status='old', position="append",action="write",iostat=status) if (status /= 0) then write(*,*) 'Error opening file: ', filename stop endif else - open(unit=file_id, file=filename, status='new', action='write', iostat=status) + open(unit=file_id,file=filename,status='new',action='write',iostat=status) if (status /= 0) then write(*,*) 'Error creating file: ', filename stop @@ -1215,7 +1215,7 @@ subroutine calculate_temp_cut(temperature_array,count_bound,temp_cut,max_temp,te temp_array_test(m) = temp_start temp_start = temp_start + dtemp endif - end do + enddo ! Allocate arrays to save the number of particles per bin allocate(temp_array_new(count_possible_temp),count_particles_temp(count_possible_temp), array_input(count_possible_temp),avg_density(count_possible_temp)) From ca9231a250dd5dc65cd10e05f3ba016af5b862d4 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 10 Dec 2024 17:44:43 +1100 Subject: [PATCH 37/54] [indent-bot] standardised indentation --- src/main/inject_windtunnel.f90 | 6 +- src/main/substepping.F90 | 472 +++++++------- src/setup/setup_grtde.f90 | 158 ++--- src/setup/setup_windtunnel.f90 | 2 +- src/tests/test_gr.f90 | 2 +- src/utils/analysis_kepler.f90 | 1064 ++++++++++++++++---------------- 6 files changed, 852 insertions(+), 852 deletions(-) diff --git a/src/main/inject_windtunnel.f90 b/src/main/inject_windtunnel.f90 index c074c78ce..98ad6ef1f 100644 --- a/src/main/inject_windtunnel.f90 +++ b/src/main/inject_windtunnel.f90 @@ -297,10 +297,10 @@ subroutine subtract_star_vcom(nsphere,xyzh,vxyzu) vstar = vstar/real(nbulk) do i=1,nsphere - if (xyzh(1,i) < 2.*Rstar) then + if (xyzh(1,i) < 2.*Rstar) then vxyzu(1:3,i) = vxyzu(1:3,i) - vstar - endif -enddo + endif + enddo end subroutine subtract_star_vcom diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index ae0c08291..4ed81320c 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1144,124 +1144,124 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & !$omp reduction(min:dtextforcenew) predictor: do i=1,npart - xyz(1) = xyzh(1,i) - xyz(2) = xyzh(2,i) - xyz(3) = xyzh(3,i) - hi = xyzh(4,i) - if (.not.isdead_or_accreted(hi)) then - if (ntypes > 1 .and. maxphase==maxp) then - itype = iamtype(iphase(i)) - if (use_apr) then - pmassi = aprmassoftype(itype,apr_level(i)) - else - pmassi = massoftype(itype) + xyz(1) = xyzh(1,i) + xyz(2) = xyzh(2,i) + xyz(3) = xyzh(3,i) + hi = xyzh(4,i) + if (.not.isdead_or_accreted(hi)) then + if (ntypes > 1 .and. maxphase==maxp) then + itype = iamtype(iphase(i)) + if (use_apr) then + pmassi = aprmassoftype(itype,apr_level(i)) + else + pmassi = massoftype(itype) + endif + elseif (use_apr) then + pmassi = aprmassoftype(igas,apr_level(i)) endif - elseif (use_apr) then - pmassi = aprmassoftype(igas,apr_level(i)) - endif - its = 0 - converged = .false. - ! - ! make local copies of array quantities - ! - pxyz(1:3) = pxyzu(1:3,i) - eni = pxyzu(4,i) - vxyz(1:3) = vxyzu(1:3,i) - uui = vxyzu(4,i) - fexti = fext(:,i) - - pxyz = pxyz + hdt*fexti - - !-- unpack thermo variables for the first guess in cons2prim - densi = dens(i) - pri = eos_vars(igasP,i) - gammai = eos_vars(igamma,i) - tempi = eos_vars(itemp,i) - rhoi = rhoh(hi,massoftype(igas)) - - ! Note: grforce needs derivatives of the metric, - ! which do not change between pmom iterations - pmom_iterations: do while (its <= itsmax .and. .not. converged) - its = its + 1 - pprev = pxyz + its = 0 + converged = .false. + ! + ! make local copies of array quantities + ! + pxyz(1:3) = pxyzu(1:3,i) + eni = pxyzu(4,i) + vxyz(1:3) = vxyzu(1:3,i) + uui = vxyzu(4,i) + fexti = fext(:,i) + + pxyz = pxyz + hdt*fexti + + !-- unpack thermo variables for the first guess in cons2prim + densi = dens(i) + pri = eos_vars(igasP,i) + gammai = eos_vars(igamma,i) + tempi = eos_vars(itemp,i) + rhoi = rhoh(hi,massoftype(igas)) + + ! Note: grforce needs derivatives of the metric, + ! which do not change between pmom iterations + pmom_iterations: do while (its <= itsmax .and. .not. converged) + its = its + 1 + pprev = pxyz ! calculate force between sink-gas particles call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzh_ptmass, & fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_sinks,& dsdt_ptmass,fonrmax,dtphi2,bin_info) - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - call combine_forces_gr_one(fext_gas(1:3,i),fstar(1:3)) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + call combine_forces_gr_one(fext_gas(1:3,i),fstar(1:3)) - pxyz = pprev + hdt*(fstar - fexti) - pmom_err = maxval(abs(pxyz - pprev)) - if (pmom_err < ptol) converged = .true. - fexti = fstar - enddo pmom_iterations - if (its > itsmax ) call warning('substep_gr',& + pxyz = pprev + hdt*(fstar - fexti) + pmom_err = maxval(abs(pxyz - pprev)) + if (pmom_err < ptol) converged = .true. + fexti = fstar + enddo pmom_iterations + if (its > itsmax ) call warning('substep_gr',& 'max # of pmom iterations',var='pmom_err',val=pmom_err) - pitsmax = max(its,pitsmax) - perrmax = max(pmom_err,perrmax) + pitsmax = max(its,pitsmax) + perrmax = max(pmom_err,perrmax) - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) - xyz = xyz + dt*vxyz - call pack_metric(xyz,metrics(:,:,:,i)) - - its = 0 - converged = .false. - vxyz_star = vxyz - ! Note: since particle positions change between iterations - ! the metric and its derivatives need to be updated. - ! cons2prim does not require derivatives of the metric, - ! so those can updated once the iterations are complete - ! in order to reduce the number of computations. - xyz_iterations: do while (its <= itsmax .and. .not. converged) - its = its+1 - xyz_prev = xyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& + if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) + xyz = xyz + dt*vxyz + call pack_metric(xyz,metrics(:,:,:,i)) + + its = 0 + converged = .false. + vxyz_star = vxyz + ! Note: since particle positions change between iterations + ! the metric and its derivatives need to be updated. + ! cons2prim does not require derivatives of the metric, + ! so those can updated once the iterations are complete + ! in order to reduce the number of computations. + xyz_iterations: do while (its <= itsmax .and. .not. converged) + its = its+1 + xyz_prev = xyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& pri,tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) - xyz = xyz_prev + hdt*(vxyz_star - vxyz) - x_err = maxval(abs(xyz-xyz_prev)) - if (x_err < xtol) converged = .true. - vxyz = vxyz_star - ! UPDATE METRIC HERE - call pack_metric(xyz,metrics(:,:,:,i)) - enddo xyz_iterations - call pack_metricderivs(xyz,metricderivs(:,:,:,i)) - if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) - xitsmax = max(its,xitsmax) - xerrmax = max(x_err,xerrmax) - - ! re-pack arrays back where they belong - xyzh(1:3,i) = xyz(1:3) - pxyzu(1:3,i) = pxyz(1:3) - vxyzu(1:3,i) = vxyz(1:3) - vxyzu(4,i) = uui - fext(:,i) = fexti - dens(i) = densi - eos_vars(igasP,i) = pri - eos_vars(itemp,i) = tempi - eos_vars(igamma,i) = gammai - - ! Skip remainder of update if boundary particle; note that fext==0 for these particles - if (iamboundary(itype)) cycle predictor - endif -enddo predictor + if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) + xyz = xyz_prev + hdt*(vxyz_star - vxyz) + x_err = maxval(abs(xyz-xyz_prev)) + if (x_err < xtol) converged = .true. + vxyz = vxyz_star + ! UPDATE METRIC HERE + call pack_metric(xyz,metrics(:,:,:,i)) + enddo xyz_iterations + call pack_metricderivs(xyz,metricderivs(:,:,:,i)) + if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) + xitsmax = max(its,xitsmax) + xerrmax = max(x_err,xerrmax) + + ! re-pack arrays back where they belong + xyzh(1:3,i) = xyz(1:3) + pxyzu(1:3,i) = pxyz(1:3) + vxyzu(1:3,i) = vxyz(1:3) + vxyzu(4,i) = uui + fext(:,i) = fexti + dens(i) = densi + eos_vars(igasP,i) = pri + eos_vars(itemp,i) = tempi + eos_vars(igamma,i) = gammai + + ! Skip remainder of update if boundary particle; note that fext==0 for these particles + if (iamboundary(itype)) cycle predictor + endif + enddo predictor !$omp end parallel do call predict_gr_sink(xyzh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fext_sinks,nptmass,& dt,timei,hdt,metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax,& xitsmax,xerrmax) - end subroutine predict_gr +end subroutine predict_gr !---------------------------------------------------------------- !+ @@ -1325,109 +1325,109 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex !$omp reduction(min:dtextforcenew) predictor: do i=1,nptmass - xyzhi(1) = xyzmh_ptmass(1,i) - xyzhi(2) = xyzmh_ptmass(2,i) - xyzhi(3) = xyzmh_ptmass(3,i) - pmassi = xyzmh_ptmass(4,i) - hi = xyzmh_ptmass(5,i) - - xyz(1) = xyzhi(1) - xyz(2) = xyzhi(2) - xyz(3) = xyzhi(3) - xyzhi(4) = hi - if (.not.isdead_or_accreted(hi)) then - its = 0 - converged = .false. - ! - ! make local copies of array quantities - ! - pxyz(1:3) = pxyzu_ptmass(1:3,i) - eni = 0. - vxyz(1:3) = vxyz_ptmass(1:3,i) - uui = 0. - fexti = fext(:,i) - pxyz = pxyz + hdt*fexti - - !-- unpack thermo variables for the first guess in cons2prim - densi = 1. - pri = 0. - gammai = 0. - tempi = 0. - rhoi = 1. - ! Note: grforce needs derivatives of the metric, - ! which do not change between pmom iterations - pmom_iterations: do while (its <= itsmax .and. .not. converged) - its = its + 1 - pprev = pxyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& + xyzhi(1) = xyzmh_ptmass(1,i) + xyzhi(2) = xyzmh_ptmass(2,i) + xyzhi(3) = xyzmh_ptmass(3,i) + pmassi = xyzmh_ptmass(4,i) + hi = xyzmh_ptmass(5,i) + + xyz(1) = xyzhi(1) + xyz(2) = xyzhi(2) + xyz(3) = xyzhi(3) + xyzhi(4) = hi + if (.not.isdead_or_accreted(hi)) then + its = 0 + converged = .false. + ! + ! make local copies of array quantities + ! + pxyz(1:3) = pxyzu_ptmass(1:3,i) + eni = 0. + vxyz(1:3) = vxyz_ptmass(1:3,i) + uui = 0. + fexti = fext(:,i) + pxyz = pxyz + hdt*fexti + + !-- unpack thermo variables for the first guess in cons2prim + densi = 1. + pri = 0. + gammai = 0. + tempi = 0. + rhoi = 1. + ! Note: grforce needs derivatives of the metric, + ! which do not change between pmom iterations + pmom_iterations: do while (its <= itsmax .and. .not. converged) + its = its + 1 + pprev = pxyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) + if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) - call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - call combine_forces_gr_one(fext_sinks(1:3,i),fstar(1:3)) + call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + call combine_forces_gr_one(fext_sinks(1:3,i),fstar(1:3)) - pxyz = pprev + hdt*(fstar - fexti) - pmom_err = maxval(abs(pxyz - pprev)) - if (pmom_err < ptol) converged = .true. - fexti = fstar - enddo pmom_iterations - if (its > itsmax ) call warning('substep_gr',& + pxyz = pprev + hdt*(fstar - fexti) + pmom_err = maxval(abs(pxyz - pprev)) + if (pmom_err < ptol) converged = .true. + fexti = fstar + enddo pmom_iterations + if (its > itsmax ) call warning('substep_gr',& 'max # of pmom iterations',var='pmom_err',val=pmom_err) - pitsmax = max(its,pitsmax) - perrmax = max(pmom_err,perrmax) + pitsmax = max(its,pitsmax) + perrmax = max(pmom_err,perrmax) - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) - xyz = xyz + dt*vxyz - call pack_metric(xyz,metrics(:,:,:,i)) - - its = 0 - converged = .false. - vxyz_star = vxyz - ! Note: since particle positions change between iterations - ! the metric and its derivatives need to be updated. - ! cons2prim does not require derivatives of the metric, - ! so those can updated once the iterations are complete - ! in order to reduce the number of computations. - xyz_iterations: do while (its <= itsmax .and. .not. converged) - its = its+1 - xyz_prev = xyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& + if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) + xyz = xyz + dt*vxyz + call pack_metric(xyz,metrics(:,:,:,i)) + + its = 0 + converged = .false. + vxyz_star = vxyz + ! Note: since particle positions change between iterations + ! the metric and its derivatives need to be updated. + ! cons2prim does not require derivatives of the metric, + ! so those can updated once the iterations are complete + ! in order to reduce the number of computations. + xyz_iterations: do while (its <= itsmax .and. .not. converged) + its = its+1 + xyz_prev = xyz + call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& pri,tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) - if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) - xyz = xyz_prev + hdt*(vxyz_star - vxyz) - x_err = maxval(abs(xyz-xyz_prev)) - if (x_err < xtol) converged = .true. - vxyz = vxyz_star - ! UPDATE METRIC HERE - call pack_metric(xyz,metrics(:,:,:,i)) - enddo xyz_iterations - call pack_metricderivs(xyz,metricderivs(:,:,:,i)) - if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) - xitsmax = max(its,xitsmax) - xerrmax = max(x_err,xerrmax) - - ! re-pack arrays back where they belong - xyzmh_ptmass(1:3,i) = xyz(1:3) - pxyzu_ptmass(1:3,i) = pxyz(1:3) - vxyz_ptmass(1:3,i) = vxyz(1:3) - fext(:,i) = fexti - - endif -enddo predictor + if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) + xyz = xyz_prev + hdt*(vxyz_star - vxyz) + x_err = maxval(abs(xyz-xyz_prev)) + if (x_err < xtol) converged = .true. + vxyz = vxyz_star + ! UPDATE METRIC HERE + call pack_metric(xyz,metrics(:,:,:,i)) + enddo xyz_iterations + call pack_metricderivs(xyz,metricderivs(:,:,:,i)) + if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) + xitsmax = max(its,xitsmax) + xerrmax = max(x_err,xerrmax) + + ! re-pack arrays back where they belong + xyzmh_ptmass(1:3,i) = xyz(1:3) + pxyzu_ptmass(1:3,i) = pxyz(1:3) + vxyz_ptmass(1:3,i) = vxyz(1:3) + fext(:,i) = fexti + + endif + enddo predictor !$omp end parallel do - end subroutine predict_gr_sink +end subroutine predict_gr_sink !---------------------------------------------------------------- !+ ! routine for accretion step in GR case !+ !---------------------------------------------------------------- - subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& +subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& pxyzu,accretedmass,hdt,npart,nptmass,ntypes,dtextforce_min,timei,& xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& metrics_ptmass,metricderivs_ptmass,& @@ -1507,12 +1507,12 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, itype = iamtype(iphase(i)) if (use_apr) then else - pmassi = massoftype(itype) + pmassi = massoftype(itype) endif - ! if (itype==iboundary) cycle accreteloop - elseif (use_apr) then - pmassi = aprmassoftype(igas,apr_level(i)) - endif + ! if (itype==iboundary) cycle accreteloop + elseif (use_apr) then + pmassi = aprmassoftype(igas,apr_level(i)) + endif call equationofstate(ieos,pondensi,spsoundi,dens(i),xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi,vxyzu(4,i)) pri = pondensi*dens(i) @@ -1552,14 +1552,14 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fext_sinks,& metrics_ptmass,metricderivs_ptmass,nlive_sinks,naccreted_sinks,pxyzu_ptmass,& accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) - end subroutine accrete_gr +end subroutine accrete_gr !---------------------------------------------------------------- !+ ! routine for accretion step in GR case !+ !---------------------------------------------------------------- - subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptmass,metricderivs_ptmass,& +subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptmass,metricderivs_ptmass,& nlive_sinks,naccreted_sinks,& pxyzu_ptmass,accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) use part, only:ihsoft @@ -1593,72 +1593,72 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptma !$omp reduction(+:accretedmass,naccreted_sinks,nlive_sinks) !$omp do accreteloop: do i=1,nptmass - pri = 0. - densi = 1. + pri = 0. + densi = 1. - ! add this force due to the curvature of the metric. - xyzhi(1:3) = xyzmh_ptmass(1:3,i) + ! add this force due to the curvature of the metric. + xyzhi(1:3) = xyzmh_ptmass(1:3,i) - ! if a sink particle is already eaten by the black hole, skip it... - pmassi = xyzmh_ptmass(4,i) - if (pmassi < 0.) cycle accreteloop - ! - ! the smoothing length is used inside get_grforce to set the timestep based - ! on h/abs(dp/dt), but for sink particles this is meaningless unless - ! a softening length is set - ! - hsofti = xyzmh_ptmass(ihsoft,i) - xyzhi(4) = huge(0.) - if (hsofti > 0.) xyzhi(4) = hsofti - call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),densi,0.,pri,fext(1:3,i),dtf) - call combine_forces_gr_one(fext_sinks(1:3,i),fext(1:3,i)) + ! if a sink particle is already eaten by the black hole, skip it... + pmassi = xyzmh_ptmass(4,i) + if (pmassi < 0.) cycle accreteloop + ! + ! the smoothing length is used inside get_grforce to set the timestep based + ! on h/abs(dp/dt), but for sink particles this is meaningless unless + ! a softening length is set + ! + hsofti = xyzmh_ptmass(ihsoft,i) + xyzhi(4) = huge(0.) + if (hsofti > 0.) xyzhi(4) = hsofti + call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),densi,0.,pri,fext(1:3,i),dtf) + call combine_forces_gr_one(fext_sinks(1:3,i),fext(1:3,i)) - dtextforce_min = min(dtextforce_min,C_force*dtf) + dtextforce_min = min(dtextforce_min,C_force*dtf) + ! + ! correct v to the full step using only the external force + ! + pxyzu_ptmass(1:3,i) = pxyzu_ptmass(1:3,i) + hdt*fext(1:3,i) + + if (iexternalforce > 0) then ! - ! correct v to the full step using only the external force + ! sending the mass twice here is deliberate, as an accreted sink particle is indicated by + ! a negative mass, unlike gas particles which are flagged with a negative smoothing length ! - pxyzu_ptmass(1:3,i) = pxyzu_ptmass(1:3,i) + hdt*fext(1:3,i) - - if (iexternalforce > 0) then - ! - ! sending the mass twice here is deliberate, as an accreted sink particle is indicated by - ! a negative mass, unlike gas particles which are flagged with a negative smoothing length - ! - call accrete_particles(iexternalforce,xyzmh_ptmass(1,i),xyzmh_ptmass(2,i), & + call accrete_particles(iexternalforce,xyzmh_ptmass(1,i),xyzmh_ptmass(2,i), & xyzmh_ptmass(3,i),xyzmh_ptmass(4,i),xyzmh_ptmass(4,i),timei,accreted) - if (accreted) then - accretedmass = accretedmass + abs(xyzmh_ptmass(4,i)) - naccreted_sinks = naccreted_sinks + 1 - endif + if (accreted) then + accretedmass = accretedmass + abs(xyzmh_ptmass(4,i)) + naccreted_sinks = naccreted_sinks + 1 endif - nlive_sinks = nlive_sinks + 1 + endif + nlive_sinks = nlive_sinks + 1 enddo accreteloop !$omp enddo !$omp end parallel - end subroutine accrete_gr_sink +end subroutine accrete_gr_sink - subroutine combine_forces_gr(nptmass,fsinks,fgr) - real, intent(in) :: fsinks(:,:) - integer, intent(in) :: nptmass +subroutine combine_forces_gr(nptmass,fsinks,fgr) + real, intent(in) :: fsinks(:,:) + integer, intent(in) :: nptmass - real, intent(inout) :: fgr(:,:) + real, intent(inout) :: fgr(:,:) - integer :: i + integer :: i - do i=1,nptmass - fgr(:,i) = fsinks(:,i) + fgr(:,i) - enddo - end subroutine combine_forces_gr + do i=1,nptmass + fgr(:,i) = fsinks(:,i) + fgr(:,i) + enddo +end subroutine combine_forces_gr - subroutine combine_forces_gr_one(fsink,fgr) - real, intent(in) :: fsink(:) - real, intent(inout) :: fgr(:) +subroutine combine_forces_gr_one(fsink,fgr) + real, intent(in) :: fsink(:) + real, intent(inout) :: fgr(:) fgr(:) = fgr(:) + fsink(:) - end subroutine combine_forces_gr_one +end subroutine combine_forces_gr_one end module substepping diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index b0c94fff4..71cc07e5a 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -127,7 +127,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, !-- Default runtime parameters ! mhole = 1.e6 ! (solar masses) -if (gr) then + if (gr) then call set_units(mass=mhole*solarm,c=1.d0,G=1.d0) !--Set umass as 1e6*msun else call set_units(mass=solarm,dist=solarr,G=1.d0) @@ -231,59 +231,59 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, print*, accradius1_hard, "accradius1_hard",mass1,"mass1" if (.not. provide_params) then - do i = 1, nstar - print*, 'mstar of star ',i,' is: ', star(i)%mstar - print*, 'rstar of star ',i,' is: ', star(i)%rstar - enddo - - xyzstar = 0. - vxyzstar = 0. - period = 0. - - if (ecc_bh<1.) then - ! - !-- Set a binary orbit given the desired orbital parameters to get the position and velocity of the star - ! - semia = rp/(1.-ecc_bh) - period = 2.*pi*sqrt(semia**3/mass1) - hacc1 = star(1)%rstar/1.e8 ! Something small so that set_binary doesnt warn about Roche lobe - hacc2 = hacc1 - ! apocentre = rp*(1.+ecc_bh)/(1.-ecc_bh) - ! trueanom = acos((rp*(1.+ecc_bh)/r0 - 1.)/ecc_bh)*180./pi - call set_binary(mass1,star(1)%mstar,semia,ecc_bh,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,& + do i = 1, nstar + print*, 'mstar of star ',i,' is: ', star(i)%mstar + print*, 'rstar of star ',i,' is: ', star(i)%rstar + enddo + + xyzstar = 0. + vxyzstar = 0. + period = 0. + + if (ecc_bh<1.) then + ! + !-- Set a binary orbit given the desired orbital parameters to get the position and velocity of the star + ! + semia = rp/(1.-ecc_bh) + period = 2.*pi*sqrt(semia**3/mass1) + hacc1 = star(1)%rstar/1.e8 ! Something small so that set_binary doesnt warn about Roche lobe + hacc2 = hacc1 + ! apocentre = rp*(1.+ecc_bh)/(1.-ecc_bh) + ! trueanom = acos((rp*(1.+ecc_bh)/r0 - 1.)/ecc_bh)*180./pi + call set_binary(mass1,star(1)%mstar,semia,ecc_bh,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,& posang_ascnode=0.,arg_peri=90.,incl=0.,f=-180.) - vxyzstar(:) = vxyz_ptmass(1:3,2) - xyzstar(:) = xyzmh_ptmass(1:3,2) - nptmass = 0 - - call rotatevec(xyzstar,(/0.,1.,0./),-theta_bh) - call rotatevec(vxyzstar,(/0.,1.,0./),-theta_bh) - - elseif (abs(ecc_bh-1.) < tiny(0.)) then - ! - !-- Setup a parabolic orbit - ! - r0 = 10.*rtidal ! A default starting distance from the black hole. - period = 2.*pi*sqrt(r0**3/mass1) !period not defined for parabolic orbit, so just need some number - y0 = -2.*rp + r0 - x0 = sqrt(r0**2 - y0**2) - xyzstar(:) = (/-x0,y0,0./) - vel = sqrt(2.*mass1/r0) - vhat = (/2.*rp,-x0,0./)/sqrt(4.*rp**2 + x0**2) - vxyzstar(:) = vel*vhat - - call rotatevec(xyzstar,(/0.,1.,0./),theta_bh) - call rotatevec(vxyzstar,(/0.,1.,0./),theta_bh) - - else - call fatal('setup','please choose a valid eccentricity (01.1) call warning('setup','Lorentz factor of star greater than 1.1, density may not be correct') - - tmax = norbits*period - dtmax = period/dumpsperorbit + vxyzstar(:) = vxyz_ptmass(1:3,2) + xyzstar(:) = xyzmh_ptmass(1:3,2) + nptmass = 0 + + call rotatevec(xyzstar,(/0.,1.,0./),-theta_bh) + call rotatevec(vxyzstar,(/0.,1.,0./),-theta_bh) + + elseif (abs(ecc_bh-1.) < tiny(0.)) then + ! + !-- Setup a parabolic orbit + ! + r0 = 10.*rtidal ! A default starting distance from the black hole. + period = 2.*pi*sqrt(r0**3/mass1) !period not defined for parabolic orbit, so just need some number + y0 = -2.*rp + r0 + x0 = sqrt(r0**2 - y0**2) + xyzstar(:) = (/-x0,y0,0./) + vel = sqrt(2.*mass1/r0) + vhat = (/2.*rp,-x0,0./)/sqrt(4.*rp**2 + x0**2) + vxyzstar(:) = vel*vhat + + call rotatevec(xyzstar,(/0.,1.,0./),theta_bh) + call rotatevec(vxyzstar,(/0.,1.,0./),theta_bh) + + else + call fatal('setup','please choose a valid eccentricity (01.1) call warning('setup','Lorentz factor of star greater than 1.1, density may not be correct') + + tmax = norbits*period + dtmax = period/dumpsperorbit endif if (id==master) then @@ -365,21 +365,21 @@ subroutine write_setupfile(filename) endif - write(iunit,"(/,a)") '# options for black hole and orbit' - call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)',iunit) - if (.not. provide_params) then - call write_inopt(beta, 'beta', 'penetration factor', iunit) - call write_inopt(ecc_bh, 'ecc_bh', 'eccentricity (1 for parabolic)', iunit) - call write_inopt(norbits, 'norbits', 'number of orbits', iunit) - call write_inopt(dumpsperorbit,'dumpsperorbit','number of dumps per orbit', iunit) - call write_inopt(theta_bh, 'theta_bh', 'inclination of orbit (degrees)', iunit) - if (nstar > 1) then + write(iunit,"(/,a)") '# options for black hole and orbit' + call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)',iunit) + if (.not. provide_params) then + call write_inopt(beta, 'beta', 'penetration factor', iunit) + call write_inopt(ecc_bh, 'ecc_bh', 'eccentricity (1 for parabolic)', iunit) + call write_inopt(norbits, 'norbits', 'number of orbits', iunit) + call write_inopt(dumpsperorbit,'dumpsperorbit','number of dumps per orbit', iunit) + call write_inopt(theta_bh, 'theta_bh', 'inclination of orbit (degrees)', iunit) + if (nstar > 1) then call write_options_orbit(orbit,iunit) - endif - else - write(iunit,"(/,a)") '# provide inputs for the binary system' - call write_params(iunit) - endif + endif + else + write(iunit,"(/,a)") '# provide inputs for the binary system' + call write_params(iunit) + endif endif close(iunit) @@ -428,18 +428,18 @@ subroutine read_setupfile(filename,ieos,polyk,mass1,ierr) call read_options_stars(star,need_iso,ieos,polyk,relax,db,nerr) endif - if (.not. provide_params) then - call read_inopt(beta, 'beta', db,min=0.,errcount=nerr) - call read_inopt(ecc_bh, 'ecc_bh', db,min=0.,max=1.,errcount=nerr) - call read_inopt(norbits, 'norbits', db,min=0.,errcount=nerr) - call read_inopt(dumpsperorbit, 'dumpsperorbit', db,min=0 ,errcount=nerr) - call read_inopt(theta_bh, 'theta_bh', db, errcount=nerr) - if (nstar > 1) then - call read_options_orbit(orbit,db,nerr) - endif - else - call read_params(db,nerr) - endif + if (.not. provide_params) then + call read_inopt(beta, 'beta', db,min=0.,errcount=nerr) + call read_inopt(ecc_bh, 'ecc_bh', db,min=0.,max=1.,errcount=nerr) + call read_inopt(norbits, 'norbits', db,min=0.,errcount=nerr) + call read_inopt(dumpsperorbit, 'dumpsperorbit', db,min=0 ,errcount=nerr) + call read_inopt(theta_bh, 'theta_bh', db, errcount=nerr) + if (nstar > 1) then + call read_options_orbit(orbit,db,nerr) + endif + else + call read_params(db,nerr) + endif endif call close_db(db) diff --git a/src/setup/setup_windtunnel.f90 b/src/setup/setup_windtunnel.f90 index d92faff17..c83dfd870 100644 --- a/src/setup/setup_windtunnel.f90 +++ b/src/setup/setup_windtunnel.f90 @@ -168,7 +168,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, vxyzu(4,i) = presi / ( (gamma-1.) * densi) enddo - deallocate(r,den,pres) + deallocate(r,den,pres) endif print*, "udist = ", udist, "; umass = ", umass, "; utime = ", utime diff --git a/src/tests/test_gr.f90 b/src/tests/test_gr.f90 index a0c9dd0ef..544ddbb5f 100644 --- a/src/tests/test_gr.f90 +++ b/src/tests/test_gr.f90 @@ -219,7 +219,7 @@ subroutine integrate_geodesic(tmax,dt,xyz,vxyz,angmom0,angmom) nsteps = nsteps + 1 time = time + dt dtextforce = blah - ! call substep_gr(npart,ntypes,dt,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time) + ! call substep_gr(npart,ntypes,dt,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time) call substep_gr(npart,nptmass,ntypes,dt,dtextforce,xyzh,vxyzu,pxyzu,dens,metrics,metricderivs,fext,time,& xyzmh_ptmass,vxyz_ptmass,pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fxyz_ptmass) enddo diff --git a/src/utils/analysis_kepler.f90 b/src/utils/analysis_kepler.f90 index 24a22e97e..8fbab5e9a 100644 --- a/src/utils/analysis_kepler.f90 +++ b/src/utils/analysis_kepler.f90 @@ -249,7 +249,7 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid "rad",& "vphi" - write(output,"(a4,i5.5)") 'vbra',numfile + write(output,"(a4,i5.5)") 'vbra',numfile open(111,file=output) write(111,"(2(a22,1x))") & "rad",& @@ -266,66 +266,66 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid 'rho' do i = 1,energy_verified_no - ! get the sorted index of bound particles - j = bound_index(i) - index_sort = sorted_index(i) - count_particles = count_particles + 1 - ! Calculate the position and velocity VEC of COM - pos_com(:) = pos_com(:) + xyzh(1:3,index_sort)*pmass - vel_com(:) = vel_com(:) + vxyzu(1:3,index_sort)*pmass - - ! Obtain the values for each particle that is bound/ part of remnant - density_i = den_npart(j) - temperature_i = temp_npart(j) - pos_i = pos_npart(j) - vel_i = vel_npart(j) - pos_vec_i(:) = pos_vec_npart(:,j) - vel_vec_i(:) = vel_vec_npart(:,j) - R_vec(:) = pos_vec_i(1:2) - R_mag_i = norm2(R_vec) - ke_i = ke_npart(j) - pe_i = pe_npart(i) - write(14,*) i,j,pos_i,vel_i,pos_vec_i(1)*udist,pos_vec_i(2)*udist,pos_vec_i(3)*udist,temperature_i,density_i*unit_density,sorted_index(i) - - ! Calculate the angular velocity in cylindrical coordinates - vphi_i = vel_vec_i(1)*(-pos_vec_i(2)/R_mag_i) + vel_vec_i(2)*(pos_vec_i(1)/R_mag_i) - vphi_i = vphi_i/R_mag_i - - ! Position magnitude of the next bound particle - if (i /= energy_verified_no) then - pos_mag_next = pos_npart(j+1) - endif - - ! composition - if (columns_compo /= 0) then - composition_i(:) = interp_comp_npart(:,j) - endif - - if (index_sort == 13) then - print*,composition_i(:),"compo in big look",j,"j",i,"i",index_sort,"index_sort2" + ! get the sorted index of bound particles + j = bound_index(i) + index_sort = sorted_index(i) + count_particles = count_particles + 1 + ! Calculate the position and velocity VEC of COM + pos_com(:) = pos_com(:) + xyzh(1:3,index_sort)*pmass + vel_com(:) = vel_com(:) + vxyzu(1:3,index_sort)*pmass + + ! Obtain the values for each particle that is bound/ part of remnant + density_i = den_npart(j) + temperature_i = temp_npart(j) + pos_i = pos_npart(j) + vel_i = vel_npart(j) + pos_vec_i(:) = pos_vec_npart(:,j) + vel_vec_i(:) = vel_vec_npart(:,j) + R_vec(:) = pos_vec_i(1:2) + R_mag_i = norm2(R_vec) + ke_i = ke_npart(j) + pe_i = pe_npart(i) + write(14,*) i,j,pos_i,vel_i,pos_vec_i(1)*udist,pos_vec_i(2)*udist,pos_vec_i(3)*udist,temperature_i,density_i*unit_density,sorted_index(i) + + ! Calculate the angular velocity in cylindrical coordinates + vphi_i = vel_vec_i(1)*(-pos_vec_i(2)/R_mag_i) + vel_vec_i(2)*(pos_vec_i(1)/R_mag_i) + vphi_i = vphi_i/R_mag_i + + ! Position magnitude of the next bound particle + if (i /= energy_verified_no) then + pos_mag_next = pos_npart(j+1) endif - ! Calculate extra quantities - if (pos_i > 0.) then - ! Radial velocity - rad_vel_i = dot_product(vel_vec_i(:),pos_vec_i)/pos_i - momentum_i = rad_vel_i*pmass - endif - ! Angular momentum - call cross_product3D(pos_vec_i(:),vel_vec_i(:),Li(:)) - L_i(:) = Li(:)*pmass - ! Moment of Inertia Matrix - call moment_of_inertia(pos_vec_i,pos_i,pmass,i_matrix) - - if (pos_i == 0.) then + ! composition + if (columns_compo /= 0) then + composition_i(:) = interp_comp_npart(:,j) + endif + + if (index_sort == 13) then + print*,composition_i(:),"compo in big look",j,"j",i,"i",index_sort,"index_sort2" + endif + + ! Calculate extra quantities + if (pos_i > 0.) then + ! Radial velocity + rad_vel_i = dot_product(vel_vec_i(:),pos_vec_i)/pos_i + momentum_i = rad_vel_i*pmass + endif + ! Angular momentum + call cross_product3D(pos_vec_i(:),vel_vec_i(:),Li(:)) + L_i(:) = Li(:)*pmass + ! Moment of Inertia Matrix + call moment_of_inertia(pos_vec_i,pos_i,pmass,i_matrix) + + if (pos_i == 0.) then omega_particle = 0. - else + else omega_vec(:) = Li(:)/pos_i**2 omega_particle = norm2(omega_vec) - endif - breakup = ((gg*i*pmass*umass)/(pos_i*udist)**3)**(0.5) - write(11,*) pos_i,omega_particle/utime,vphi_i/utime,pos_vec_i(1),pos_vec_i(2),pos_vec_i(3) - write(4,'(i9,1x,i5,1x,27(e18.10,1x),1x,i10,1x,i10)') & + endif + breakup = ((gg*i*pmass*umass)/(pos_i*udist)**3)**(0.5) + write(11,*) pos_i,omega_particle/utime,vphi_i/utime,pos_vec_i(1),pos_vec_i(2),pos_vec_i(3) + write(4,'(i9,1x,i5,1x,27(e18.10,1x),1x,i10,1x,i10)') & i, & ibin, & pos_i*udist, & @@ -349,80 +349,80 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid h_npart(j), & density_i - ! Count particles keeps track of particles in a bin. - ! Rad_inner is the radius of the first particle that is added to a bin - if (count_particles == 1) then - rad_inner = pos_i - endif - ! Calculate how many particles will go in a bin - call no_per_bin(i,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner,double_count) - - ! We sum the quantities we want to save for the particles - density_sum = density_sum + density_i - temperature_sum = temperature_sum + temperature_i - rad_mom_sum = rad_mom_sum + momentum_i - L_sum(:) = L_sum(:) + L_i(:) - I_sum(:,:) = I_sum(:,:) + i_matrix(:,:) - composition_sum(:) = composition_sum(:) + composition_i(:) - tot_e_sum = ke_i + pe_i + tot_e_sum - vphi_sum = vphi_sum + vphi_i - - ! We check id the count_particles is the same as the number_per_bin - ! If true then we save the bin information - !if (count_particles==number_per_bin .or. i==energy_verified_no) then - if (count_particles==number_per_bin) then - ! Total particles binned. Should be the same as energy_verified_no at the end - tot_binned_particles = tot_binned_particles+count_particles - - ! Calculate the bin quantities - call radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy_verified_no,pos_npart,radius_star,pos_vec_npart,rad_cyl) - - rad_grid(ibin) = radius_star - density(ibin) = density_sum/count_particles - mass_enclosed(ibin) = tot_binned_particles*pmass - bin_mass(ibin) = count_particles*pmass - ! Change the temperature of particles if its < 1.e3 to 1.e3 - if (temperature_sum < 1.e3) then - print*,"THIS BIN HAS TEMP LESS THAN 1000 K",temperature_sum - endif - temperature(ibin) = max(temperature_sum/count_particles,1e3) - rad_vel(ibin) = rad_mom_sum/bin_mass(ibin) !Radial vel of each bin is summation(vel_rad_i*m_i)/summation(m_i) - if (count_particles == 1) then - if (rad_grid(ibin)==0.) then - - angular_vel_3D(:,ibin) = L_sum(:) - else - - angular_vel_3D(:,ibin) = L_sum(:) / (pos_i**2*pmass) - endif - else - inverse_of_i = inverse(I_sum, 3) - L_reshape = reshape(L_sum(:),(/3,1/)) - matrix_result = matmul(inverse_of_i,L_reshape) - omega = reshape(matrix_result,(/3/)) - angular_vel_3D(:,ibin) = omega - endif - composition_kepler(:,ibin) = composition_sum(:)/count_particles - vphi_avg = vphi_sum/count_particles - breakup = ((gg*mass_enclosed(ibin)*umass)/(rad_grid(ibin)*udist)**3)**(0.5) - if (norm2(angular_vel_3D(:,ibin)) > 0) then - write(10,*) udist*rad_grid(ibin),norm2(angular_vel_3D(:,ibin))/utime - write(111,*) udist*rad_grid(ibin),breakup - endif - - !print*,count_particles,"count particles",ibin,"ibin",rad_grid(ibin),"rad",number_per_bin,"number per bin" - ! Reset the sum values - count_particles = 0 - density_sum = 0. - temperature_sum = 0. - rad_mom_sum = 0. - L_sum(:) = 0. - I_sum(:,:) = 0. - composition_sum(:) = 0. - vphi_sum = 0. - ibin = ibin+1 - number_per_bin = big_bins_no - endif + ! Count particles keeps track of particles in a bin. + ! Rad_inner is the radius of the first particle that is added to a bin + if (count_particles == 1) then + rad_inner = pos_i + endif + ! Calculate how many particles will go in a bin + call no_per_bin(i,count_particles,double_the_no,number_per_bin,big_bins_no,energy_verified_no,pos_mag_next,rad_inner,double_count) + + ! We sum the quantities we want to save for the particles + density_sum = density_sum + density_i + temperature_sum = temperature_sum + temperature_i + rad_mom_sum = rad_mom_sum + momentum_i + L_sum(:) = L_sum(:) + L_i(:) + I_sum(:,:) = I_sum(:,:) + i_matrix(:,:) + composition_sum(:) = composition_sum(:) + composition_i(:) + tot_e_sum = ke_i + pe_i + tot_e_sum + vphi_sum = vphi_sum + vphi_i + + ! We check id the count_particles is the same as the number_per_bin + ! If true then we save the bin information + !if (count_particles==number_per_bin .or. i==energy_verified_no) then + if (count_particles==number_per_bin) then + ! Total particles binned. Should be the same as energy_verified_no at the end + tot_binned_particles = tot_binned_particles+count_particles + + ! Calculate the bin quantities + call radius_of_remnant(bound_index,count_particles,number_per_bin,i,energy_verified_no,pos_npart,radius_star,pos_vec_npart,rad_cyl) + + rad_grid(ibin) = radius_star + density(ibin) = density_sum/count_particles + mass_enclosed(ibin) = tot_binned_particles*pmass + bin_mass(ibin) = count_particles*pmass + ! Change the temperature of particles if its < 1.e3 to 1.e3 + if (temperature_sum < 1.e3) then + print*,"THIS BIN HAS TEMP LESS THAN 1000 K",temperature_sum + endif + temperature(ibin) = max(temperature_sum/count_particles,1e3) + rad_vel(ibin) = rad_mom_sum/bin_mass(ibin) !Radial vel of each bin is summation(vel_rad_i*m_i)/summation(m_i) + if (count_particles == 1) then + if (rad_grid(ibin)==0.) then + + angular_vel_3D(:,ibin) = L_sum(:) + else + + angular_vel_3D(:,ibin) = L_sum(:) / (pos_i**2*pmass) + endif + else + inverse_of_i = inverse(I_sum, 3) + L_reshape = reshape(L_sum(:),(/3,1/)) + matrix_result = matmul(inverse_of_i,L_reshape) + omega = reshape(matrix_result,(/3/)) + angular_vel_3D(:,ibin) = omega + endif + composition_kepler(:,ibin) = composition_sum(:)/count_particles + vphi_avg = vphi_sum/count_particles + breakup = ((gg*mass_enclosed(ibin)*umass)/(rad_grid(ibin)*udist)**3)**(0.5) + if (norm2(angular_vel_3D(:,ibin)) > 0) then + write(10,*) udist*rad_grid(ibin),norm2(angular_vel_3D(:,ibin))/utime + write(111,*) udist*rad_grid(ibin),breakup + endif + + !print*,count_particles,"count particles",ibin,"ibin",rad_grid(ibin),"rad",number_per_bin,"number per bin" + ! Reset the sum values + count_particles = 0 + density_sum = 0. + temperature_sum = 0. + rad_mom_sum = 0. + L_sum(:) = 0. + I_sum(:,:) = 0. + composition_sum(:) = 0. + vphi_sum = 0. + ibin = ibin+1 + number_per_bin = big_bins_no + endif enddo close(111) close(4) @@ -450,103 +450,103 @@ subroutine phantom_to_kepler_arrays(xyzh,vxyzu,pmass,npart,time,density,rad_grid call write_dump_info(numfile,density(1),temperature(1),mass_enclosed(ibin),xpos,rad_grid(ibin),distance_from_bh,& pos_com_mag,vel_com_mag,total_star,ke_star,u_star,time,vel_at_infinity) - end subroutine phantom_to_kepler_arrays +end subroutine phantom_to_kepler_arrays !---------------------------------------------------------------- !+ ! This subroutine returns the magntitude of the COM pos and vel !+ !---------------------------------------------------------------- - subroutine determine_pos_vel_com(vel_com,pos_com,pos_com_mag,vel_com_mag,tot_rem_mass) - real,intent(inout),dimension(3) :: vel_com,pos_com - real,intent(in) :: tot_rem_mass - real,intent(out) :: vel_com_mag,pos_com_mag +subroutine determine_pos_vel_com(vel_com,pos_com,pos_com_mag,vel_com_mag,tot_rem_mass) + real,intent(inout),dimension(3) :: vel_com,pos_com + real,intent(in) :: tot_rem_mass + real,intent(out) :: vel_com_mag,pos_com_mag - ! Divide the pos_com and vel_com with the total mass enclosed - pos_com(:) = pos_com(:)/tot_rem_mass - vel_com(:) = vel_com(:)/tot_rem_mass + ! Divide the pos_com and vel_com with the total mass enclosed + pos_com(:) = pos_com(:)/tot_rem_mass + vel_com(:) = vel_com(:)/tot_rem_mass - pos_com_mag = norm2(pos_com) - vel_com_mag = norm2(vel_com) + pos_com_mag = norm2(pos_com) + vel_com_mag = norm2(vel_com) - end subroutine determine_pos_vel_com +end subroutine determine_pos_vel_com !---------------------------------------------------------------- !+ ! This subroutine returns if remnant is bound or unbound !+ !---------------------------------------------------------------- - subroutine determine_bound_unbound(vel_com,pos_com,pos_com_mag,vel_com_mag,bhmass,tot_rem_mass,pmass,& +subroutine determine_bound_unbound(vel_com,pos_com,pos_com_mag,vel_com_mag,bhmass,tot_rem_mass,pmass,& tot_energy_remnant_com,ke_star,pe_star,vel_at_infinity) - use units , only : udist,umass,unit_velocity - use physcon,only : gg - - real,intent(in) :: vel_com_mag,pos_com_mag,bhmass,tot_rem_mass,pmass - real,intent(in) :: pos_com(3),vel_com(3) - real,intent(out):: ke_star,pe_star,tot_energy_remnant_com,vel_at_infinity - real :: bhmass_cgs,rem_mass - real :: period_val,vel_com_cgs(3),pos_com_cgs(3) - real :: er, ar - - bhmass_cgs = bhmass*umass - rem_mass = tot_rem_mass*umass - vel_com_cgs(:) = vel_com(:)*unit_velocity - pos_com_cgs(:) = pos_com(:)*udist - ! Check if Total specific Energy of COM is < 0 or not (in cgs units) - ke_star = 0.5*(vel_com_mag*unit_velocity)**2 - pe_star = -gg*bhmass_cgs/(pos_com_mag*udist) - tot_energy_remnant_com = ke_star + pe_star - print*,vel_com_cgs,"CGS vel com",pos_com_cgs,"CGS pos com" - - if (tot_energy_remnant_com < 0.) then - print*, "REMNANT IS BOUND TO THE BLACKHOLE",tot_energy_remnant_com,"energy val" - call determine_orbital_params(rem_mass,bhmass_cgs,pos_com_cgs,vel_com_cgs,period_val) - ar = -gg*0.5*(bhmass_cgs + rem_mass)/tot_energy_remnant_com - er = 1 - (56.77892268*udist)/ar - print*,"******************" - print*,ar/1.496e13,"ar",er,"er" - elseif (tot_energy_remnant_com == 0.) then - print*, "Parabolic orbit!" - else - print*, "REMNANT IS UNBOUND" - call determine_inf_vel(tot_energy_remnant_com,vel_at_infinity) - print*,"VELOCITY OF REMNANT IN kms/s :",vel_at_infinity*1e-5 - ar = gg*0.5*(bhmass_cgs + rem_mass)/tot_energy_remnant_com - er = 1 + (56.77892268*udist)/ar - print*,"******************" - print*,ar/1.496e13,"ar",er,"er" - endif - - print*,pmass*(0.5*vel_com_mag**2 - (1/pos_com_mag)),"ENERGY OF COM" - end subroutine determine_bound_unbound + use units , only : udist,umass,unit_velocity + use physcon,only : gg + + real,intent(in) :: vel_com_mag,pos_com_mag,bhmass,tot_rem_mass,pmass + real,intent(in) :: pos_com(3),vel_com(3) + real,intent(out):: ke_star,pe_star,tot_energy_remnant_com,vel_at_infinity + real :: bhmass_cgs,rem_mass + real :: period_val,vel_com_cgs(3),pos_com_cgs(3) + real :: er, ar + + bhmass_cgs = bhmass*umass + rem_mass = tot_rem_mass*umass + vel_com_cgs(:) = vel_com(:)*unit_velocity + pos_com_cgs(:) = pos_com(:)*udist + ! Check if Total specific Energy of COM is < 0 or not (in cgs units) + ke_star = 0.5*(vel_com_mag*unit_velocity)**2 + pe_star = -gg*bhmass_cgs/(pos_com_mag*udist) + tot_energy_remnant_com = ke_star + pe_star + print*,vel_com_cgs,"CGS vel com",pos_com_cgs,"CGS pos com" + + if (tot_energy_remnant_com < 0.) then + print*, "REMNANT IS BOUND TO THE BLACKHOLE",tot_energy_remnant_com,"energy val" + call determine_orbital_params(rem_mass,bhmass_cgs,pos_com_cgs,vel_com_cgs,period_val) + ar = -gg*0.5*(bhmass_cgs + rem_mass)/tot_energy_remnant_com + er = 1 - (56.77892268*udist)/ar + print*,"******************" + print*,ar/1.496e13,"ar",er,"er" + elseif (tot_energy_remnant_com == 0.) then + print*, "Parabolic orbit!" + else + print*, "REMNANT IS UNBOUND" + call determine_inf_vel(tot_energy_remnant_com,vel_at_infinity) + print*,"VELOCITY OF REMNANT IN kms/s :",vel_at_infinity*1e-5 + ar = gg*0.5*(bhmass_cgs + rem_mass)/tot_energy_remnant_com + er = 1 + (56.77892268*udist)/ar + print*,"******************" + print*,ar/1.496e13,"ar",er,"er" + endif + + print*,pmass*(0.5*vel_com_mag**2 - (1/pos_com_mag)),"ENERGY OF COM" +end subroutine determine_bound_unbound !---------------------------------------------------------------- !+ ! This subroutine returns the vel infinity for the remnant ! if its unbound !+ !---------------------------------------------------------------- - subroutine determine_orbital_params(rem_mass,bhmass_cgs,pos_com,vel_com,period_val) - use orbits_data, only : escape,semimajor_axis,period_star,eccentricity_star - real,intent(in) :: rem_mass,bhmass_cgs,pos_com(3),vel_com(3) - real,intent(out):: period_val - real :: ecc_val - - ecc_val = eccentricity_star(rem_mass,bhmass_cgs,pos_com,vel_com) - print*,ecc_val,"ECCENTRICITY VALUE!!!!",rem_mass,"rem mass", bhmass_cgs,"bhmass cgs",pos_com,"com pos",vel_com,"com vel" - period_val = period_star(rem_mass,bhmass_cgs,pos_com,vel_com) - print*,period_val,"PERIOD OF STAR" - - end subroutine determine_orbital_params +subroutine determine_orbital_params(rem_mass,bhmass_cgs,pos_com,vel_com,period_val) + use orbits_data, only : escape,semimajor_axis,period_star,eccentricity_star + real,intent(in) :: rem_mass,bhmass_cgs,pos_com(3),vel_com(3) + real,intent(out):: period_val + real :: ecc_val + + ecc_val = eccentricity_star(rem_mass,bhmass_cgs,pos_com,vel_com) + print*,ecc_val,"ECCENTRICITY VALUE!!!!",rem_mass,"rem mass", bhmass_cgs,"bhmass cgs",pos_com,"com pos",vel_com,"com vel" + period_val = period_star(rem_mass,bhmass_cgs,pos_com,vel_com) + print*,period_val,"PERIOD OF STAR" + +end subroutine determine_orbital_params !---------------------------------------------------------------- !+ ! This subroutine returns the oribital properties !+ !---------------------------------------------------------------- - subroutine determine_inf_vel(tot_energy_remnant_com,vel_at_infinity) - real,intent(in) :: tot_energy_remnant_com - real,intent(out):: vel_at_infinity +subroutine determine_inf_vel(tot_energy_remnant_com,vel_at_infinity) + real,intent(in) :: tot_energy_remnant_com + real,intent(out):: vel_at_infinity - vel_at_infinity = sqrt(2.*tot_energy_remnant_com) + vel_at_infinity = sqrt(2.*tot_energy_remnant_com) - end subroutine determine_inf_vel +end subroutine determine_inf_vel !---------------------------------------------------------------- !+ ! This subroutine returns the position and velocity of a @@ -571,85 +571,85 @@ end subroutine particle_pos_and_vel_wrt_centre ! This subroutine returns which particles are bound to the star !+ !---------------------------------------------------------------- - subroutine particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sorted_index_npart,bound_index,sorted_index,bound_particles_no,& +subroutine particles_bound_to_star(pos_npart,temp_npart,tot_eng_npart,npart,sorted_index_npart,bound_index,sorted_index,bound_particles_no,& last_particle_with_neg_e,ke_npart,pe_npart,den_npart) - real,intent(in) :: temp_npart(:),tot_eng_npart(:),ke_npart(:),pe_npart(:),pos_npart(:),den_npart(:) - integer,intent(in) :: sorted_index_npart(:) - integer,intent(in) :: npart - - integer,allocatable,intent(out) :: bound_index(:),sorted_index(:) - integer,intent(out) :: bound_particles_no,last_particle_with_neg_e - integer :: energy_verified_no,i - real,allocatable :: index_particle_star(:),temp_bound(:),temp_particles(:) - integer,allocatable :: index_bound(:),index_bound_sorted(:),index_bound_new(:) - real :: max_temp=8000.,index_val - integer :: count_loops_temp=0 - logical :: temp_found,implement_temp_cut - real :: temp_cut - - ! Implement temp cut would try to remove the strems. But if you only want - ! to consider what is bound based on energy condition set this parameter to False - implement_temp_cut = .true. - bound_particles_no = 0 - temp_found = .false. - energy_verified_no = 0 - allocate(index_particle_star(npart),index_bound(npart),temp_particles(npart)) - open(unit=10,file="particle_index_clean") - ! Use the sorted array information and check the energy condition first - do i=1,npart - !if energy is less than 0, we have bound system. We can accept these particles. - if (tot_eng_npart(i) < 0. .and. ke_npart(i) < 0.5*abs(pe_npart(i))) then - write(10,*) i,temp_npart(i),pos_npart(i),sorted_index_npart(i) - energy_verified_no = energy_verified_no + 1 - ! Save the index of these particles - ! this is because sometimes even if a particle is farther it could be could but the one before could be unbound - last_particle_with_neg_e = i - index_particle_star(energy_verified_no) = sorted_index_npart(i) - index_bound(energy_verified_no) = i - temp_particles(energy_verified_no) = temp_npart(i) - print*,"YES BOUND",i,"i" - endif - enddo - close(10) - allocate(temp_bound(energy_verified_no), index_bound_sorted(energy_verified_no),index_bound_new(energy_verified_no)) - do i = 1,energy_verified_no - temp_bound(i) = temp_particles(i) - ! This is the sorted index - index_bound_sorted(i) = index_particle_star(i) - index_bound_new(i) = index_bound(i) - enddo - if (implement_temp_cut) then - ! next we loop over the bound particles based on energy condition to find the temp_cut - ! As the models would need ages to evolve and I can not do that due to how slow some models run, we have streams around the remnants - ! Hence, we bin the temperature particles and try to find the cut in temperature - ! But using a temperature cut of 8000 K implies that if I use a model that has streams at high temperature (>1e4 K) because the remnant has just formed - ! then I would not get rid of the correct particles - ! Hence, we keep looping until the temperature being returned is the same as the max_temp - count_loops_temp = count_loops_temp + 1 - call calculate_temp_cut(temp_bound,energy_verified_no,temp_cut,max_temp,temp_found,count_loops_temp,den_npart) - max_temp = max_temp + 1000 - - allocate(bound_index(energy_verified_no),sorted_index(energy_verified_no)) - ! use temp_cut to ignore the streams - do i = 1,energy_verified_no + real,intent(in) :: temp_npart(:),tot_eng_npart(:),ke_npart(:),pe_npart(:),pos_npart(:),den_npart(:) + integer,intent(in) :: sorted_index_npart(:) + integer,intent(in) :: npart + + integer,allocatable,intent(out) :: bound_index(:),sorted_index(:) + integer,intent(out) :: bound_particles_no,last_particle_with_neg_e + integer :: energy_verified_no,i + real,allocatable :: index_particle_star(:),temp_bound(:),temp_particles(:) + integer,allocatable :: index_bound(:),index_bound_sorted(:),index_bound_new(:) + real :: max_temp=8000.,index_val + integer :: count_loops_temp=0 + logical :: temp_found,implement_temp_cut + real :: temp_cut + + ! Implement temp cut would try to remove the strems. But if you only want + ! to consider what is bound based on energy condition set this parameter to False + implement_temp_cut = .true. + bound_particles_no = 0 + temp_found = .false. + energy_verified_no = 0 + allocate(index_particle_star(npart),index_bound(npart),temp_particles(npart)) + open(unit=10,file="particle_index_clean") + ! Use the sorted array information and check the energy condition first + do i=1,npart + !if energy is less than 0, we have bound system. We can accept these particles. + if (tot_eng_npart(i) < 0. .and. ke_npart(i) < 0.5*abs(pe_npart(i))) then + write(10,*) i,temp_npart(i),pos_npart(i),sorted_index_npart(i) + energy_verified_no = energy_verified_no + 1 + ! Save the index of these particles + ! this is because sometimes even if a particle is farther it could be could but the one before could be unbound + last_particle_with_neg_e = i + index_particle_star(energy_verified_no) = sorted_index_npart(i) + index_bound(energy_verified_no) = i + temp_particles(energy_verified_no) = temp_npart(i) + print*,"YES BOUND",i,"i" + endif + enddo + close(10) + allocate(temp_bound(energy_verified_no), index_bound_sorted(energy_verified_no),index_bound_new(energy_verified_no)) + do i = 1,energy_verified_no + temp_bound(i) = temp_particles(i) + ! This is the sorted index + index_bound_sorted(i) = index_particle_star(i) + index_bound_new(i) = index_bound(i) + enddo + if (implement_temp_cut) then + ! next we loop over the bound particles based on energy condition to find the temp_cut + ! As the models would need ages to evolve and I can not do that due to how slow some models run, we have streams around the remnants + ! Hence, we bin the temperature particles and try to find the cut in temperature + ! But using a temperature cut of 8000 K implies that if I use a model that has streams at high temperature (>1e4 K) because the remnant has just formed + ! then I would not get rid of the correct particles + ! Hence, we keep looping until the temperature being returned is the same as the max_temp + count_loops_temp = count_loops_temp + 1 + call calculate_temp_cut(temp_bound,energy_verified_no,temp_cut,max_temp,temp_found,count_loops_temp,den_npart) + max_temp = max_temp + 1000 + + allocate(bound_index(energy_verified_no),sorted_index(energy_verified_no)) + ! use temp_cut to ignore the streams + do i = 1,energy_verified_no if (temp_bound(i) > temp_cut) then bound_particles_no = bound_particles_no + 1 ! Save the sorted array indices only bound_index(bound_particles_no) = index_bound_new(i) sorted_index(bound_particles_no) = index_bound_sorted(i) if (sorted_index(bound_particles_no) == 13) then - print*, bound_index(bound_particles_no),"bound_index(bound_particles_no)" + print*, bound_index(bound_particles_no),"bound_index(bound_particles_no)" endif endif - enddo - else - bound_particles_no = energy_verified_no - allocate(bound_index(energy_verified_no),sorted_index(energy_verified_no)) - bound_index(:) = index_bound_new(:) - sorted_index(:) = index_bound_sorted(:) - endif - end subroutine particles_bound_to_star + enddo + else + bound_particles_no = energy_verified_no + allocate(bound_index(energy_verified_no),sorted_index(energy_verified_no)) + bound_index(:) = index_bound_new(:) + sorted_index(:) = index_bound_sorted(:) + endif +end subroutine particles_bound_to_star !---------------------------------------------------------------- !+ ! This subroutine returns number of particles that can be put into @@ -691,7 +691,7 @@ subroutine no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no if (i /= 0) then ! File does not exist, create it open(unit=15,file="rad_to_bin",status='new',action='write',iostat=i) - endif + endif if (j==1) then number_per_bin = 1 @@ -704,15 +704,15 @@ subroutine no_per_bin(j,count_particles,double_the_no,number_per_bin,big_bins_no double_the_no = .False. endif else - if (double_the_no == .False. .and. j /= count_particles) then - if (100*(pos_mag_next-rad_inner)/rad_inner > 30) then - !print*,(((pos_mag_next-rad_inner)/rad_inner)*100),"per inc",j,"j",count_particles,"count_particles" - write(15,*) pos_mag_next,rad_inner,j,number_per_bin - number_per_bin=count_particles - !if (number_per_bin < min_no) then - ! number_per_bin = min_no - ! endif - endif + if (double_the_no == .False. .and. j /= count_particles) then + if (100*(pos_mag_next-rad_inner)/rad_inner > 30) then + !print*,(((pos_mag_next-rad_inner)/rad_inner)*100),"per inc",j,"j",count_particles,"count_particles" + write(15,*) pos_mag_next,rad_inner,j,number_per_bin + number_per_bin=count_particles + !if (number_per_bin < min_no) then + ! number_per_bin = min_no + ! endif + endif endif endif if (j==energy_verified_no) then @@ -779,100 +779,100 @@ end subroutine moment_of_inertia ! Density is also sorted and saved. Along with the radius !+ !---------------------------------------------------------------- - subroutine calculate_npart_quantities(npart,iorder,numfile,xyzh,vxyzu,pmass,xpos,vpos,comp_label,& +subroutine calculate_npart_quantities(npart,iorder,numfile,xyzh,vxyzu,pmass,xpos,vpos,comp_label,& interpolate_comp,columns_compo,temp_npart,den_npart,pos_npart,vel_npart,& pos_vec_npart,vel_vec_npart,tot_eng_npart,sorted_index_npart,ke_npart,pe_npart,& pos_wrt_bh,vel_wrt_bh,h_npart,interp_comp_npart) - use units , only : udist,umass,unit_velocity,unit_energ - use vectorutils, only : cross_product3D - use part, only : rhoh,poten - use sortutils, only : set_r2func_origin,indexxfunc,r2func_origin - use eos, only : equationofstate,entropy,X_in,Z_in,gmw,init_eos - use physcon, only : gg - - integer,intent(in) :: npart,iorder(:),numfile - real,intent(in) :: xyzh(:,:),vxyzu(:,:) - real,intent(in) :: pmass - real,intent(inout) :: xpos(:),vpos(:) - character(len=20),intent(in) :: comp_label(:) - real,intent(in) :: interpolate_comp(:,:) - integer,intent(in) :: columns_compo - real,allocatable,intent(out) :: temp_npart(:),den_npart(:),pos_npart(:),vel_npart(:),pos_wrt_bh(:,:),vel_wrt_bh(:,:),h_npart(:) - real,allocatable,intent(out) :: pos_vec_npart(:,:),vel_vec_npart(:,:),tot_eng_npart(:) - real,allocatable,intent(out) :: ke_npart(:),pe_npart(:),interp_comp_npart(:,:) - integer,allocatable,intent(out) :: sorted_index_npart(:) - - integer :: i,j,ierr,ieos - real :: pos(3),vel(3) - real :: potential_i, kinetic_i,energy_i,pos_mag,vel_mag - real :: density_i,temperature_i,eni_input,u_i - real :: ponrhoi,spsoundi,mu - real,allocatable :: composition_i(:) - real,allocatable :: A_array(:), Z_array(:) - - ieos = 2 - gmw = 0.61 - call init_eos(ieos,ierr) - allocate(composition_i(columns_compo)) - call assign_atomic_mass_and_number(comp_label,A_array,Z_array) - ! Allocate arrays to save the sorted index,density,temperature,radius,total energy of particle wrt centre, velocity_npart - allocate(temp_npart(npart),den_npart(npart),pos_npart(npart),vel_npart(npart),sorted_index_npart(npart),tot_eng_npart(npart),ke_npart(npart),pe_npart(npart)) - allocate(pos_vec_npart(3,npart),vel_vec_npart(3,npart),pos_wrt_bh(3,npart),vel_wrt_bh(3,npart),h_npart(npart),interp_comp_npart(columns_compo,npart)) - - do j = 1, npart - !Access the rank of each particle in radius and save the sorted index - i = iorder(j) - sorted_index_npart(j) = i - - !if (columns_compo /= 0) then - ! composition_i(:) = interpolate_comp(:,i) - !endif - - !the position of the particle is calculated by subtracting the point of - !highest density. - !xyzh is position wrt the black hole present at origin. - call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos,vel,i,pos_mag,vel_mag) - !calculate the position which is the location of the particle. - potential_i = poten(i) - kinetic_i = 0.5*pmass*vel_mag**2 - density_i = rhoh(xyzh(4,i),pmass) - energy_i = potential_i + kinetic_i + vxyzu(4,i)*pmass - print*,potential_i,"POTENTIAL I",kinetic_i,"Kinetic I" - - ! composition - if (columns_compo /= 0) then - composition_i(:) = interpolate_comp(:,i) - endif - if (i == 13) then - print*,composition_i(:),"compo",i,"i before",j,"j" - endif - ! calculate mean molecular weight that is required by the eos module using - ! the mass fractions for each particle. - ! do not consider neutron which is the first element of the composition_i array. - call calculate_mu(A_array,Z_array,composition_i,columns_compo,mu) - gmw = 1./mu - u_i = vxyzu(4,i) - eni_input = u_i - call equationofstate(ieos,ponrhoi,spsoundi,density_i,xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi=temperature_i,eni=eni_input) - ! Save the information for each particle that we need - den_npart(j) = density_i - temp_npart(j) = temperature_i - pos_npart(j) = pos_mag - vel_npart(j) = vel_mag - vel_vec_npart(:,j) = vel(:) - pos_vec_npart(:,j) = pos(:) - tot_eng_npart(j) = energy_i - ke_npart(j) = kinetic_i - pe_npart(j) = potential_i - pos_wrt_bh(:,j) = xyzh(1:3,i) - vel_wrt_bh(:,j) = vxyzu(1:3,i) - h_npart(j) = xyzh(4,i) - - interp_comp_npart(:,j) = interpolate_comp(:,i) - enddo - - end subroutine calculate_npart_quantities + use units , only : udist,umass,unit_velocity,unit_energ + use vectorutils, only : cross_product3D + use part, only : rhoh,poten + use sortutils, only : set_r2func_origin,indexxfunc,r2func_origin + use eos, only : equationofstate,entropy,X_in,Z_in,gmw,init_eos + use physcon, only : gg + + integer,intent(in) :: npart,iorder(:),numfile + real,intent(in) :: xyzh(:,:),vxyzu(:,:) + real,intent(in) :: pmass + real,intent(inout) :: xpos(:),vpos(:) + character(len=20),intent(in) :: comp_label(:) + real,intent(in) :: interpolate_comp(:,:) + integer,intent(in) :: columns_compo + real,allocatable,intent(out) :: temp_npart(:),den_npart(:),pos_npart(:),vel_npart(:),pos_wrt_bh(:,:),vel_wrt_bh(:,:),h_npart(:) + real,allocatable,intent(out) :: pos_vec_npart(:,:),vel_vec_npart(:,:),tot_eng_npart(:) + real,allocatable,intent(out) :: ke_npart(:),pe_npart(:),interp_comp_npart(:,:) + integer,allocatable,intent(out) :: sorted_index_npart(:) + + integer :: i,j,ierr,ieos + real :: pos(3),vel(3) + real :: potential_i, kinetic_i,energy_i,pos_mag,vel_mag + real :: density_i,temperature_i,eni_input,u_i + real :: ponrhoi,spsoundi,mu + real,allocatable :: composition_i(:) + real,allocatable :: A_array(:), Z_array(:) + + ieos = 2 + gmw = 0.61 + call init_eos(ieos,ierr) + allocate(composition_i(columns_compo)) + call assign_atomic_mass_and_number(comp_label,A_array,Z_array) + ! Allocate arrays to save the sorted index,density,temperature,radius,total energy of particle wrt centre, velocity_npart + allocate(temp_npart(npart),den_npart(npart),pos_npart(npart),vel_npart(npart),sorted_index_npart(npart),tot_eng_npart(npart),ke_npart(npart),pe_npart(npart)) + allocate(pos_vec_npart(3,npart),vel_vec_npart(3,npart),pos_wrt_bh(3,npart),vel_wrt_bh(3,npart),h_npart(npart),interp_comp_npart(columns_compo,npart)) + + do j = 1, npart + !Access the rank of each particle in radius and save the sorted index + i = iorder(j) + sorted_index_npart(j) = i + + !if (columns_compo /= 0) then + ! composition_i(:) = interpolate_comp(:,i) + !endif + + !the position of the particle is calculated by subtracting the point of + !highest density. + !xyzh is position wrt the black hole present at origin. + call particle_pos_and_vel_wrt_centre(xpos,vpos,xyzh,vxyzu,pos,vel,i,pos_mag,vel_mag) + !calculate the position which is the location of the particle. + potential_i = poten(i) + kinetic_i = 0.5*pmass*vel_mag**2 + density_i = rhoh(xyzh(4,i),pmass) + energy_i = potential_i + kinetic_i + vxyzu(4,i)*pmass + print*,potential_i,"POTENTIAL I",kinetic_i,"Kinetic I" + + ! composition + if (columns_compo /= 0) then + composition_i(:) = interpolate_comp(:,i) + endif + if (i == 13) then + print*,composition_i(:),"compo",i,"i before",j,"j" + endif + ! calculate mean molecular weight that is required by the eos module using + ! the mass fractions for each particle. + ! do not consider neutron which is the first element of the composition_i array. + call calculate_mu(A_array,Z_array,composition_i,columns_compo,mu) + gmw = 1./mu + u_i = vxyzu(4,i) + eni_input = u_i + call equationofstate(ieos,ponrhoi,spsoundi,density_i,xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi=temperature_i,eni=eni_input) + ! Save the information for each particle that we need + den_npart(j) = density_i + temp_npart(j) = temperature_i + pos_npart(j) = pos_mag + vel_npart(j) = vel_mag + vel_vec_npart(:,j) = vel(:) + pos_vec_npart(:,j) = pos(:) + tot_eng_npart(j) = energy_i + ke_npart(j) = kinetic_i + pe_npart(j) = potential_i + pos_wrt_bh(:,j) = xyzh(1:3,i) + vel_wrt_bh(:,j) = vxyzu(1:3,i) + h_npart(j) = xyzh(4,i) + + interp_comp_npart(:,j) = interpolate_comp(:,i) + enddo + +end subroutine calculate_npart_quantities !---------------------------------------------------------------- !+ ! This routine reads the output file that contains composition @@ -1094,20 +1094,20 @@ subroutine write_dump_info(fileno,density,temperature,mass,xpos,rad,distance,pos ! open the file for appending or creating if (file_exists) then - open(unit=file_id,file=filename,status='old', position="append",action="write",iostat=status) - if (status /= 0) then - write(*,*) 'Error opening file: ', filename - stop - endif + open(unit=file_id,file=filename,status='old', position="append",action="write",iostat=status) + if (status /= 0) then + write(*,*) 'Error opening file: ', filename + stop + endif -else - open(unit=file_id,file=filename,status='new',action='write',iostat=status) - if (status /= 0) then - write(*,*) 'Error creating file: ', filename - stop - endif - ! Write headers to file - write(file_id,'(17(a22,1x))') & + else + open(unit=file_id,file=filename,status='new',action='write',iostat=status) + if (status /= 0) then + write(*,*) 'Error creating file: ', filename + stop + endif + ! Write headers to file + write(file_id,'(17(a22,1x))') & "FileNo", & "Density",& "Temperature",& @@ -1125,10 +1125,10 @@ subroutine write_dump_info(fileno,density,temperature,mass,xpos,rad,distance,pos "time",& "Escape_in",& "Accretion_r" -endif -write(file_id,'(i5,1x,16(e18.10,1x))')fileno,density*unit_density,temperature,mass*umass,xpos(1)*udist,xpos(2)*udist,xpos(3)*udist,rad*udist,distance*udist,pos_mag_star*udist,& + endif + write(file_id,'(i5,1x,16(e18.10,1x))')fileno,density*unit_density,temperature,mass*umass,xpos(1)*udist,xpos(2)*udist,xpos(3)*udist,rad*udist,distance*udist,pos_mag_star*udist,& vel_mag_star*unit_velocity,tot_energy,kinetic_energy,potential_energy,time*utime,vel_at_infinity*1e-5,(mass*umass)/(time/(365*24*3600)*utime) -close(file_id) + close(file_id) end subroutine write_dump_info @@ -1140,42 +1140,42 @@ end subroutine write_dump_info !+ !---------------------------------------------------------------- subroutine write_compo_wrt_bh(xyzh,vxyzu,xpos,vpos,pmass,npart,iorder,array_bh_j,interpolate_comp,columns_compo,comp_label,energy_verified_no,last_particle_with_neg_e) - use units , only: udist - - real,intent(in) :: xyzh(:,:),vxyzu(:,:) - real,intent(in) :: xpos(3),vpos(3),pmass - integer,intent(in) :: npart,iorder(:),columns_compo - integer,allocatable,intent(in) :: array_bh_j(:) - integer,intent(in) :: energy_verified_no,last_particle_with_neg_e - character(len=20),intent(in) :: comp_label(:) - real,intent(in) :: interpolate_comp(:,:) - - integer,allocatable :: array_particle_j(:) - real,allocatable :: composition_i(:) - integer :: i,j - real :: pos_to_bh - character(len=120) :: output - - !call particles_bound_to_star(xpos,vpos,xyzh,vxyzu,pmass,npart,iorder,energy_verified_no,last_particle_with_neg_e,array_particle_j,array_bh_j) - !call composition_array(interpolate_comp,columns_compo,comp_label) - write(output,"(a8)") 'compo_bh' - open(4,file=output) - write(4,"(19(a22,1x))") & + use units , only: udist + + real,intent(in) :: xyzh(:,:),vxyzu(:,:) + real,intent(in) :: xpos(3),vpos(3),pmass + integer,intent(in) :: npart,iorder(:),columns_compo + integer,allocatable,intent(in) :: array_bh_j(:) + integer,intent(in) :: energy_verified_no,last_particle_with_neg_e + character(len=20),intent(in) :: comp_label(:) + real,intent(in) :: interpolate_comp(:,:) + + integer,allocatable :: array_particle_j(:) + real,allocatable :: composition_i(:) + integer :: i,j + real :: pos_to_bh + character(len=120) :: output + + !call particles_bound_to_star(xpos,vpos,xyzh,vxyzu,pmass,npart,iorder,energy_verified_no,last_particle_with_neg_e,array_particle_j,array_bh_j) + !call composition_array(interpolate_comp,columns_compo,comp_label) + write(output,"(a8)") 'compo_bh' + open(4,file=output) + write(4,"(19(a22,1x))") & "posToBH", & comp_label - allocate(composition_i(columns_compo)) - do j = 1, size(array_bh_j) - i = iorder(j) !Access the rank of each particle in radius. - pos_to_bh = sqrt(dot_product(xyzh(1:3,i),xyzh(1:3,i))) - if (columns_compo /= 0) then + allocate(composition_i(columns_compo)) + do j = 1, size(array_bh_j) + i = iorder(j) !Access the rank of each particle in radius. + pos_to_bh = sqrt(dot_product(xyzh(1:3,i),xyzh(1:3,i))) + if (columns_compo /= 0) then composition_i(:) = interpolate_comp(:,i) - endif - write(4,'(19(e18.10,1x))') & + endif + write(4,'(19(e18.10,1x))') & pos_to_bh*udist,& composition_i(:) - enddo - close(4) + enddo + close(4) end subroutine write_compo_wrt_bh @@ -1186,105 +1186,105 @@ end subroutine write_compo_wrt_bh !+ !---------------------------------------------------------------- subroutine calculate_temp_cut(temperature_array,count_bound,temp_cut,max_temp,temp_found,count_loops_temp,density_array) - real,intent(in) :: temperature_array(:),max_temp,density_array(:) - integer,intent(in) :: count_bound,count_loops_temp - real,intent(out) :: temp_cut - integer :: i,count_possible_temp,m - integer,parameter :: nbins=20000 - real, dimension(nbins)::temp_array_test - real,allocatable :: avg_density(:) - real,allocatable :: temp_array_new(:),count_particles_temp(:),diff_count_particles(:),diff2_count_particles(:),diff3_count_particles(:),array_input(:) - real :: temp_start,count_temp_particles=0,dtemp - integer :: index_val,avg_inde - real :: mean,variance,std,cut_off - real :: count_cut,count_cut_index,lower_limit,upper_limit - logical, intent(inout) :: temp_found - - - ! First we create an array of possible temperature from max_temp to 0 with a step size of 100. - temp_start = 0. - dtemp = 100. - - count_cut_index = 0 - count_cut = 0. - count_possible_temp=1+(max_temp/dtemp) - - ! Create array with the temperatures ranging from 0 to max_temp - do m=1,nbins - if (temp_start <= max_temp) then - temp_array_test(m) = temp_start - temp_start = temp_start + dtemp - endif - enddo - - ! Allocate arrays to save the number of particles per bin - allocate(temp_array_new(count_possible_temp),count_particles_temp(count_possible_temp), array_input(count_possible_temp),avg_density(count_possible_temp)) - - count_particles_temp(:) = 0 - - ! Next we create the same size array as count_possible_temp - do m=1,count_possible_temp - temp_array_new(m) = temp_array_test(m) - enddo - - ! this will count the particles for each temperature and then save them into a new array - do i =1,count_bound - do m=1,size(temp_array_new)-1 - if (temperature_array(i) >= temp_array_new(m) .and. temperature_array(i) < temp_array_new(m+1) ) then - count_temp_particles = count_particles_temp(m) + 1 - count_particles_temp(m) = count_temp_particles - avg_density(m) = density_array(i) - endif + real,intent(in) :: temperature_array(:),max_temp,density_array(:) + integer,intent(in) :: count_bound,count_loops_temp + real,intent(out) :: temp_cut + integer :: i,count_possible_temp,m + integer,parameter :: nbins=20000 + real, dimension(nbins)::temp_array_test + real,allocatable :: avg_density(:) + real,allocatable :: temp_array_new(:),count_particles_temp(:),diff_count_particles(:),diff2_count_particles(:),diff3_count_particles(:),array_input(:) + real :: temp_start,count_temp_particles=0,dtemp + integer :: index_val,avg_inde + real :: mean,variance,std,cut_off + real :: count_cut,count_cut_index,lower_limit,upper_limit + logical, intent(inout) :: temp_found + + + ! First we create an array of possible temperature from max_temp to 0 with a step size of 100. + temp_start = 0. + dtemp = 100. + + count_cut_index = 0 + count_cut = 0. + count_possible_temp=1+(max_temp/dtemp) + + ! Create array with the temperatures ranging from 0 to max_temp + do m=1,nbins + if (temp_start <= max_temp) then + temp_array_test(m) = temp_start + temp_start = temp_start + dtemp + endif + enddo + + ! Allocate arrays to save the number of particles per bin + allocate(temp_array_new(count_possible_temp),count_particles_temp(count_possible_temp), array_input(count_possible_temp),avg_density(count_possible_temp)) + + count_particles_temp(:) = 0 + + ! Next we create the same size array as count_possible_temp + do m=1,count_possible_temp + temp_array_new(m) = temp_array_test(m) + enddo + + ! this will count the particles for each temperature and then save them into a new array + do i =1,count_bound + do m=1,size(temp_array_new)-1 + if (temperature_array(i) >= temp_array_new(m) .and. temperature_array(i) < temp_array_new(m+1) ) then + count_temp_particles = count_particles_temp(m) + 1 + count_particles_temp(m) = count_temp_particles + avg_density(m) = density_array(i) + endif enddo - enddo - - print*,"***-------------------------------------" - print*,temp_array_new,"TEMP ARRAY",size(temp_array_new) - print*,count_particles_temp,"COUNT PARTICLES TEMP",size(count_particles_temp) - print*,avg_density,"AVG DENSITY FOR EACH BIN" - print*,"***-------------------------------------" - ! Calculate the mean, std of the data - call statistics(count_particles_temp,mean,variance,std) - - ! Using 2 sigma as the data sample is small to determine the outlier - cut_off = std*2 - lower_limit = mean - cut_off - upper_limit = mean + cut_off - - - ! This loops and find the last element which is outside the limits based on 2 sigma - do i=1,size(count_particles_temp) - if (count_particles_temp(i) > upper_limit .or. count_particles_temp(i) < lower_limit) then - count_cut = count_particles_temp(i) - count_cut_index = i - endif - enddo - print*,count_cut,"count cut first",count_cut_index,"count_cut_index" - ! this starts from the cound_cut_index found earlier but then tries to make sure that the cut is done when the gaussian bins - ! have less than 5% particles compared to the max_temp_cut found above - do i=count_cut_index,size(count_particles_temp) - if ((count_particles_temp(i)/count_cut)*100 < 1.) then - count_cut = count_particles_temp(i) - print*,count_cut,"count_cut",(count_particles_temp(i)/count_cut)*100,"(count_particles_temp(i)/count_cut)*100" - count_cut_index = i - exit - endif - enddo - - !print*,count_cut_index,"final cut index" - - ! Define the temperature to cut the model at - temp_cut = temp_array_new(count_cut_index) - - if (temp_cut /= max_temp) then - temp_found = .true. - endif - - ! If we get the temp_cut as 0. K and the count_loops_temp is 1, then we accept that as a true value - if (temp_cut == 0.0 .and. count_loops_temp /= 1) then - temp_found = .false. - endif - print*,temp_cut,"TEMP CUT" + enddo + + print*,"***-------------------------------------" + print*,temp_array_new,"TEMP ARRAY",size(temp_array_new) + print*,count_particles_temp,"COUNT PARTICLES TEMP",size(count_particles_temp) + print*,avg_density,"AVG DENSITY FOR EACH BIN" + print*,"***-------------------------------------" + ! Calculate the mean, std of the data + call statistics(count_particles_temp,mean,variance,std) + + ! Using 2 sigma as the data sample is small to determine the outlier + cut_off = std*2 + lower_limit = mean - cut_off + upper_limit = mean + cut_off + + + ! This loops and find the last element which is outside the limits based on 2 sigma + do i=1,size(count_particles_temp) + if (count_particles_temp(i) > upper_limit .or. count_particles_temp(i) < lower_limit) then + count_cut = count_particles_temp(i) + count_cut_index = i + endif + enddo + print*,count_cut,"count cut first",count_cut_index,"count_cut_index" + ! this starts from the cound_cut_index found earlier but then tries to make sure that the cut is done when the gaussian bins + ! have less than 5% particles compared to the max_temp_cut found above + do i=count_cut_index,size(count_particles_temp) + if ((count_particles_temp(i)/count_cut)*100 < 1.) then + count_cut = count_particles_temp(i) + print*,count_cut,"count_cut",(count_particles_temp(i)/count_cut)*100,"(count_particles_temp(i)/count_cut)*100" + count_cut_index = i + exit + endif + enddo + + !print*,count_cut_index,"final cut index" + + ! Define the temperature to cut the model at + temp_cut = temp_array_new(count_cut_index) + + if (temp_cut /= max_temp) then + temp_found = .true. + endif + + ! If we get the temp_cut as 0. K and the count_loops_temp is 1, then we accept that as a true value + if (temp_cut == 0.0 .and. count_loops_temp /= 1) then + temp_found = .false. + endif + print*,temp_cut,"TEMP CUT" end subroutine calculate_temp_cut ! -------------------------------------------------------------------- @@ -1292,25 +1292,25 @@ end subroutine calculate_temp_cut ! ! -------------------------------------------------------------------- subroutine statistics(array_data,mean,variance,std) - real,allocatable,intent(in) :: array_data(:) - real,intent(out) :: mean,variance - integer :: size_array,i - real :: var,sum_val,std - - sum_val = 0. - var = 0. - size_array = size(array_data) - do i=1,size_array - sum_val = sum_val + array_data(i) - enddo - mean = sum_val/size_array - - do i=1,size_array - var = var + (array_data(i) - mean)**2 - enddo - - variance = var/(size_array-1) - std = sqrt(variance) + real,allocatable,intent(in) :: array_data(:) + real,intent(out) :: mean,variance + integer :: size_array,i + real :: var,sum_val,std + + sum_val = 0. + var = 0. + size_array = size(array_data) + do i=1,size_array + sum_val = sum_val + array_data(i) + enddo + mean = sum_val/size_array + + do i=1,size_array + var = var + (array_data(i) - mean)**2 + enddo + + variance = var/(size_array-1) + std = sqrt(variance) end subroutine statistics From be1c63e6b81603aec650b1e5181e22c6f4623868 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Wed, 11 Dec 2024 16:45:47 +1100 Subject: [PATCH 38/54] (gr sink) nptmass added in shared due to OPENMP* error --- src/main/substepping.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 4ed81320c..1565570da 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1316,7 +1316,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex !$omp parallel do default(none) & !$omp shared(xyzmh_ptmass,vxyz_ptmass,fext,iphase,ntypes,massoftype) & !$omp shared(maxphase,maxp,eos_vars) & - !$omp shared(dt,hdt,xtol,ptol) & + !$omp shared(dt,hdt,xtol,ptol,nptmass) & !$omp shared(ieos,pxyzu_ptmass,metrics,metricderivs,ien_type) & !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce,fext_sinks) & !$omp private(i,its,tempi,rhoi,hi,eni,uui,densi,xyzhi) & From 17681a122685974c956fc57288c28cec6464e14a Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 12 Dec 2024 10:04:42 +1100 Subject: [PATCH 39/54] =?UTF-8?q?(gr=20sink)=20fix=20bug=20Unused=20module?= =?UTF-8?q?=20variable=20=E2=80=98fext=5Fptmass=E2=80=99=20which=20has=20b?= =?UTF-8?q?een=20explicitly=20imported=20at=20(1)=20that=20I=20got=20on=20?= =?UTF-8?q?github=20tests=20run?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/main/initial.F90 | 7 +++---- src/main/part.F90 | 3 --- src/main/step_leapfrog.F90 | 7 +++---- 3 files changed, 6 insertions(+), 11 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 2d59a18d7..8f6a7e273 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -143,14 +143,13 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) nden_nimhd,dustevol,rhoh,gradh,apr_level,aprmassoftype,& Bevol,Bxyz,dustprop,filfac,ddustprop,ndustsmall,iboundary,eos_vars,dvdx, & n_group,n_ingroup,n_sing,nmatrix,group_info,bin_info,isionised - use part, only:pxyzu,dens,metrics,rad,radprop,drad,ithick,metrics_ptmass,pxyzu_ptmass,& - fext_ptmass + use part, only:pxyzu,dens,metrics,rad,radprop,drad,ithick use densityforce, only:densityiterate use linklist, only:set_linklist use boundary_dyn, only:dynamic_bdy,init_dynamic_bdy use substepping, only:combine_forces_gr #ifdef GR - use part, only:metricderivs,metricderivs_ptmass + use part, only:metricderivs,metricderivs_ptmass,metrics_ptmass,pxyzu_ptmass use cons2prim, only:prim2consall use eos, only:ieos use extern_gr, only:get_grforce_all,get_tmunu_all,get_tmunu_all_exact @@ -234,7 +233,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) integer :: ierr,i,j,nerr,nwarn,ialphaloc,irestart,merge_n,merge_ij(maxptmass) real :: poti,hfactfile real :: hi,pmassi,rhoi1 - real :: dtsinkgas,dtsinksink,fonrmax,dtphi2,dtnew_first,dtinject + real :: dtsinkgas,dtsinksink,fonrmax,dtphi2,dtnew_first,dtinject,fext_ptmass(4,nptmass) real :: stressmax,xmin,ymin,zmin,xmax,ymax,zmax,dx,dy,dz,tolu,toll real :: dummy(3) real :: gmw_nicil diff --git a/src/main/part.F90 b/src/main/part.F90 index 934bf192e..b2ecb91dc 100644 --- a/src/main/part.F90 +++ b/src/main/part.F90 @@ -193,7 +193,6 @@ module part real, allocatable :: pxyzu_ptmass(:,:) !pxyz_ptmass(maxvxyzu,maxgr) real, allocatable :: metrics_ptmass(:,:,:,:) !metrics(0:3,0:3,2,maxgr) real, allocatable :: metricderivs_ptmass(:,:,:,:) !metricderivs(0:3,0:3,3,maxgr) - real, allocatable :: fext_ptmass(:,:) ! !--sink particles ! @@ -484,7 +483,6 @@ subroutine allocate_part call allocate_array('pxyzu_ptmass', pxyzu_ptmass, maxvxyzu, maxptmassgr) call allocate_array('metrics_ptmass', metrics_ptmass, 4, 4, 2, maxptmassgr) call allocate_array('metricderivs_ptmass', metricderivs_ptmass, 4, 4, 3, maxptmassgr) - call allocate_array('fext_ptmass', fext_ptmass, 4, maxptmassgr) call allocate_array('xyzmh_ptmass', xyzmh_ptmass, nsinkproperties, maxptmass) call allocate_array('vxyz_ptmass', vxyz_ptmass, 3, maxptmass) call allocate_array('fxyz_ptmass', fxyz_ptmass, 4, maxptmass) @@ -582,7 +580,6 @@ subroutine deallocate_part if (allocated(pxyzu_ptmass)) deallocate(pxyzu_ptmass) if (allocated(metrics_ptmass)) deallocate(metrics_ptmass) if (allocated(metricderivs_ptmass)) deallocate(metricderivs_ptmass) - if (allocated(fext_ptmass)) deallocate(fext_ptmass) if (allocated(xyzmh_ptmass)) deallocate(xyzmh_ptmass) if (allocated(vxyz_ptmass)) deallocate(vxyz_ptmass) if (allocated(fxyz_ptmass)) deallocate(fxyz_ptmass) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index 5e68c3d26..773042253 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -98,8 +98,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) iamboundary,get_ntypes,npartoftypetot,apr_level,& dustfrac,dustevol,ddustevol,eos_vars,alphaind,nptmass,& dustprop,ddustprop,dustproppred,pxyzu,dens,metrics,ics,& - filfac,filfacpred,mprev,filfacprev,aprmassoftype,isionised,epot_sinksink,& - fext_ptmass + filfac,filfacpred,mprev,filfacprev,aprmassoftype,isionised,epot_sinksink use options, only:avdecayconst,alpha,ieos,alphamax use deriv, only:derivs use timestep, only:dterr,bignumber,tolv,C_force @@ -142,7 +141,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) real :: v2mean,hdti real :: dtsinksink real :: fonrmax,poti,dtphi2 - real :: fext_gas(4,npart),fext_sinks(4,nptmass) + real :: fext_gas(4,npart),fext_ptmass(4,nptmass) integer :: merge_ij(nptmass) integer :: merge_n real(kind=4) :: t1,t2,tcpu1,tcpu2 @@ -157,7 +156,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) ! fext_gas = 0. - fext_sinks = 0. + fext_ptmass = 0. timei = t hdtsph = 0.5*dtsph dterr = bignumber From fd90de69812191e374740e171db3a80664bdeee2 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 12 Dec 2024 16:53:10 +1100 Subject: [PATCH 40/54] (gr sink) fixing error when doing testgravity because it calls test_binary_sink_gr --- src/main/cons2prim.f90 | 18 +++++++++--------- src/tests/test_ptmass.f90 | 11 ++++++----- 2 files changed, 15 insertions(+), 14 deletions(-) diff --git a/src/main/cons2prim.f90 b/src/main/cons2prim.f90 index c853ef48b..648389676 100644 --- a/src/main/cons2prim.f90 +++ b/src/main/cons2prim.f90 @@ -218,15 +218,15 @@ end subroutine cons2primall ! from the evolved/conservative variables (rho*,momentum,entropy) !+ !---------------------------------------------------------------------- -subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,eos_vars) +subroutine cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass,eos_vars) use cons2primsolver, only:conservative2primitive use part, only:isdead_or_accreted,massoftype,igas,rhoh,igasP,ics,ien_type,& itemp,igamma use io, only:fatal use eos, only:ieos,done_init_eos,init_eos,get_spsound - integer, intent(in) :: npart - real, intent(in) :: pxyzu(:,:),xyzh(:,:),metrics(:,:,:,:) - real, intent(inout) :: vxyzu(:,:) + integer, intent(in) :: nptmass + real, intent(in) :: pxyzu_ptmass(:,:),xyzmh_ptmass(:,:),metrics_ptmass(:,:,:,:) + real, intent(inout) :: vxyz_ptmass(:,:) real, intent(out), optional :: eos_vars(:,:) integer :: i, ierr real :: p_guess,rhoi,tempi,gammai,eni,densi @@ -234,21 +234,21 @@ subroutine cons2primall_sink(npart,xyzh,metrics,pxyzu,vxyzu,eos_vars) if (.not.done_init_eos) call init_eos(ieos,ierr) !$omp parallel do default (none) & -!$omp shared(xyzh,metrics,vxyzu,pxyzu,npart,massoftype) & +!$omp shared(xyzmh_ptmass,metrics_ptmass,vxyz_ptmass,pxyzu_ptmass,nptmass,massoftype) & !$omp shared(ieos,eos_vars,ien_type) & !$omp private(i,ierr,p_guess,rhoi,tempi,gammai,eni,densi) - do i=1,npart + do i=1,nptmass p_guess = 0. tempi = 0. gammai = 0. rhoi = 1. densi = 1. ! conservative 2 primitive - call conservative2primitive(xyzh(1:3,i),metrics(:,:,:,i),vxyzu(1:3,i),densi,eni, & - p_guess,tempi,gammai,rhoi,pxyzu(1:3,i),pxyzu(4,i),ierr,ien_type) + call conservative2primitive(xyzmh_ptmass(1:3,i),metrics_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),densi,eni, & + p_guess,tempi,gammai,rhoi,pxyzu_ptmass(1:3,i),pxyzu_ptmass(4,i),ierr,ien_type) if (ierr > 0) then - print*,' pmom =',pxyzu(1:3,i) + print*,' pmom =',pxyzu_ptmass(1:3,i) print*,' rho* =',rhoi print*,' en =',eni call fatal('cons2prim','could not solve rootfinding',i) diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 61796ab9f..682897262 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -32,7 +32,7 @@ module testptmass subroutine test_ptmass(ntests,npass,string) use io, only:id,master,iskfile use eos, only:polyk,gamma - use part, only:nptmass + use part, only:nptmass,gr use options, only:iexternalforce,alpha use ptmass, only:use_fourthorder,set_integration_precision character(len=*), intent(in) :: string @@ -63,7 +63,7 @@ subroutine test_ptmass(ntests,npass,string) case('ptmassbinary') do_test_binary = .true. case('ptmassgenrel') - do_test_binary_gr = .true. + if (gr) do_test_binary_gr = .true. case('ptmassaccrete') do_test_accretion = .true. case('ptmasscreatesink') @@ -129,7 +129,7 @@ subroutine test_ptmass(ntests,npass,string) ! ! Test for sink particles in GR ! - if (do_test_binary_gr .or. testall) call test_sink_binary_gr(ntests,npass,string) + if (do_test_binary_gr) call test_sink_binary_gr(ntests,npass,string) ! ! Test of sink particle potentials ! @@ -1166,14 +1166,15 @@ subroutine test_merger(ntests,npass) real :: t,dt,dtext,dtnew,dtsinksink,r2,v2 real :: angmom0,mtot0,mv0,dx(3),dv(3) real :: fxyz_sinksink(4,max_to_test) - + print*, gr, "gr is used?" + read(*,*) iseed = -74205 nfailed(:) = 0 iverbose = 0 nptmass = 2 npart = 0 h_acc = 0.1 - h_soft_sinksink = h_acc + h_soft_sinksink = h_acc r_merge_uncond = 2.*h_acc ! sinks will unconditionally merge if they touch r_merge_cond = 4.*h_acc ! sinks will merge if bound within this radius r_merge_uncond2 = r_merge_uncond**2 From 576e4d95089869af52be9eb753f409a4fbc8ea90 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Thu, 12 Dec 2024 16:57:59 +1100 Subject: [PATCH 41/54] (gr sink) cleaned the code --- src/main/energies.F90 | 1 - src/main/step_leapfrog.F90 | 1 - src/tests/test_ptmass.f90 | 4 ++-- 3 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src/main/energies.F90 b/src/main/energies.F90 index b6e29c0d6..564e085ca 100644 --- a/src/main/energies.F90 +++ b/src/main/energies.F90 @@ -630,7 +630,6 @@ subroutine compute_energies(t) pyi = pxyzu_ptmass(2,i) pzi = pxyzu_ptmass(3,i) - mtot = mtot + pmassi call unpack_metric(metrics_ptmass(:,:,:,i),betaUP=beta_gr_UP,alpha=alpha_gr,gammaijdown=gammaijdown) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index 773042253..323564b89 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -280,7 +280,6 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) endif else if (nptmass > 0 .or. iexternalforce > 0 .or. h2chemistry .or. cooling_in_step .or. idamp > 0) then - call substep(npart,ntypes,nptmass,dtsph,dtextforce,t,xyzh,vxyzu,& fext,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,dsdt_ptmass,& dptmass,linklist_ptmass,fsink_old,nbinmax,ibin_wake,gtgrad, & diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 682897262..d2d754e99 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -1157,6 +1157,7 @@ subroutine test_merger(ntests,npass) use timestep, only:dtmax use mpiutils, only:bcast_mpi,reduce_in_place_mpi use energies, only:compute_energies,angtot,totmom,mtot + integer, intent(inout) :: ntests,npass integer, parameter :: max_to_test = 100 logical, parameter :: print_sink_paths = .false. ! print sink paths in the merger test @@ -1166,8 +1167,7 @@ subroutine test_merger(ntests,npass) real :: t,dt,dtext,dtnew,dtsinksink,r2,v2 real :: angmom0,mtot0,mv0,dx(3),dv(3) real :: fxyz_sinksink(4,max_to_test) - print*, gr, "gr is used?" - read(*,*) + iseed = -74205 nfailed(:) = 0 iverbose = 0 From b1239b0849a869aadabf7437c7b839da23804d76 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 13 Dec 2024 11:19:34 +1100 Subject: [PATCH 42/54] fext_ptmass only decleared for GR case now --- src/main/initial.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 8f6a7e273..58455193f 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -233,12 +233,12 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) integer :: ierr,i,j,nerr,nwarn,ialphaloc,irestart,merge_n,merge_ij(maxptmass) real :: poti,hfactfile real :: hi,pmassi,rhoi1 - real :: dtsinkgas,dtsinksink,fonrmax,dtphi2,dtnew_first,dtinject,fext_ptmass(4,nptmass) + real :: dtsinkgas,dtsinksink,fonrmax,dtphi2,dtnew_first,dtinject real :: stressmax,xmin,ymin,zmin,xmax,ymax,zmax,dx,dy,dz,tolu,toll real :: dummy(3) real :: gmw_nicil #ifndef GR - real :: dtf,fextv(3) + real :: dtf,fextv(3),fext_ptmass(4,nptmass) #endif integer :: itype,iposinit,ipostmp,ntypes,nderivinit logical :: iexist,read_input_files From 002b2b38d41dee08fca94da10c667da6d77e5ad7 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Fri, 13 Dec 2024 11:34:12 +1100 Subject: [PATCH 43/54] Fixed the error about not defining fext_ptmass correctly --- src/main/initial.F90 | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index 58455193f..dbce5a3dc 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -238,8 +238,11 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) real :: dummy(3) real :: gmw_nicil #ifndef GR - real :: dtf,fextv(3),fext_ptmass(4,nptmass) + real :: dtf,fextv(3) #endif +#ifdef GR + real :: fext_ptmass(4,nptmass) +#endif integer :: itype,iposinit,ipostmp,ntypes,nderivinit logical :: iexist,read_input_files character(len=len(dumpfile)) :: dumpfileold From 01bd9a63c517b5196f52b5554ef4336aacd04a4b Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Sat, 14 Dec 2024 15:59:28 +1100 Subject: [PATCH 44/54] (gr sink) cleaning code based on Daniel's suggestions --- src/main/cons2prim.f90 | 9 ++------- src/setup/setup_grtde.f90 | 1 + src/tests/test_ptmass.f90 | 4 ++-- 3 files changed, 5 insertions(+), 9 deletions(-) diff --git a/src/main/cons2prim.f90 b/src/main/cons2prim.f90 index 648389676..d3e076bf2 100644 --- a/src/main/cons2prim.f90 +++ b/src/main/cons2prim.f90 @@ -220,10 +220,8 @@ end subroutine cons2primall !---------------------------------------------------------------------- subroutine cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass,eos_vars) use cons2primsolver, only:conservative2primitive - use part, only:isdead_or_accreted,massoftype,igas,rhoh,igasP,ics,ien_type,& - itemp,igamma use io, only:fatal - use eos, only:ieos,done_init_eos,init_eos,get_spsound + use part, only:ien_type integer, intent(in) :: nptmass real, intent(in) :: pxyzu_ptmass(:,:),xyzmh_ptmass(:,:),metrics_ptmass(:,:,:,:) real, intent(inout) :: vxyz_ptmass(:,:) @@ -231,11 +229,8 @@ subroutine cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vx integer :: i, ierr real :: p_guess,rhoi,tempi,gammai,eni,densi - if (.not.done_init_eos) call init_eos(ieos,ierr) - !$omp parallel do default (none) & -!$omp shared(xyzmh_ptmass,metrics_ptmass,vxyz_ptmass,pxyzu_ptmass,nptmass,massoftype) & -!$omp shared(ieos,eos_vars,ien_type) & +!$omp shared(xyzmh_ptmass,metrics_ptmass,vxyz_ptmass,pxyzu_ptmass,nptmass,ien_type) & !$omp private(i,ierr,p_guess,rhoi,tempi,gammai,eni,densi) do i=1,nptmass p_guess = 0. diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 3fac073fb..f79374041 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -128,6 +128,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, xyzh(:,:) = 0. vxyzu(:,:) = 0. nptmass = 0 + nstar = 1 ! !-- Default runtime parameters ! diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index d2d754e99..758fabb4d 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -63,7 +63,7 @@ subroutine test_ptmass(ntests,npass,string) case('ptmassbinary') do_test_binary = .true. case('ptmassgenrel') - if (gr) do_test_binary_gr = .true. + do_test_binary_gr = .true. case('ptmassaccrete') do_test_accretion = .true. case('ptmasscreatesink') @@ -123,7 +123,7 @@ subroutine test_ptmass(ntests,npass,string) ! ! Test sink particle mergers ! - if (do_test_merger .or. testall) call test_merger(ntests,npass) + if ((do_test_binary_gr .or. testall) .and. gr) call test_merger(ntests,npass) enddo ! From 73b659d4e87b7eed77836fd17dc75120b7d288e7 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Sat, 14 Dec 2024 16:39:48 +1100 Subject: [PATCH 45/54] (sink gr) fext_ptmass is only defined once in part.f90 --- src/main/initial.F90 | 5 +---- src/main/part.F90 | 3 +++ src/main/step_leapfrog.F90 | 6 ++---- src/main/substepping.F90 | 27 +++++++++++++-------------- 4 files changed, 19 insertions(+), 22 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index dbce5a3dc..b9544f08f 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -149,7 +149,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) use boundary_dyn, only:dynamic_bdy,init_dynamic_bdy use substepping, only:combine_forces_gr #ifdef GR - use part, only:metricderivs,metricderivs_ptmass,metrics_ptmass,pxyzu_ptmass + use part, only:metricderivs,metricderivs_ptmass,metrics_ptmass,pxyzu_ptmass,fext_ptmass use cons2prim, only:prim2consall use eos, only:ieos use extern_gr, only:get_grforce_all,get_tmunu_all,get_tmunu_all_exact @@ -240,9 +240,6 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) #ifndef GR real :: dtf,fextv(3) #endif -#ifdef GR - real :: fext_ptmass(4,nptmass) -#endif integer :: itype,iposinit,ipostmp,ntypes,nderivinit logical :: iexist,read_input_files character(len=len(dumpfile)) :: dumpfileold diff --git a/src/main/part.F90 b/src/main/part.F90 index b2ecb91dc..f2553f98e 100644 --- a/src/main/part.F90 +++ b/src/main/part.F90 @@ -193,6 +193,7 @@ module part real, allocatable :: pxyzu_ptmass(:,:) !pxyz_ptmass(maxvxyzu,maxgr) real, allocatable :: metrics_ptmass(:,:,:,:) !metrics(0:3,0:3,2,maxgr) real, allocatable :: metricderivs_ptmass(:,:,:,:) !metricderivs(0:3,0:3,3,maxgr) + real, allocatable :: fext_ptmass(:,:) ! !--sink particles ! @@ -484,6 +485,7 @@ subroutine allocate_part call allocate_array('metrics_ptmass', metrics_ptmass, 4, 4, 2, maxptmassgr) call allocate_array('metricderivs_ptmass', metricderivs_ptmass, 4, 4, 3, maxptmassgr) call allocate_array('xyzmh_ptmass', xyzmh_ptmass, nsinkproperties, maxptmass) + call allocate_array('fext_ptmass', fext_ptmass, 4, maxptmassgr) call allocate_array('vxyz_ptmass', vxyz_ptmass, 3, maxptmass) call allocate_array('fxyz_ptmass', fxyz_ptmass, 4, maxptmass) call allocate_array('fxyz_ptmass_sinksink', fxyz_ptmass_sinksink, 4, maxptmass) @@ -581,6 +583,7 @@ subroutine deallocate_part if (allocated(metrics_ptmass)) deallocate(metrics_ptmass) if (allocated(metricderivs_ptmass)) deallocate(metricderivs_ptmass) if (allocated(xyzmh_ptmass)) deallocate(xyzmh_ptmass) + if (allocated(fext_ptmass)) deallocate(fext_ptmass) if (allocated(vxyz_ptmass)) deallocate(vxyz_ptmass) if (allocated(fxyz_ptmass)) deallocate(fxyz_ptmass) if (allocated(fxyz_ptmass_sinksink)) deallocate(fxyz_ptmass_sinksink) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index 323564b89..a6b7faf26 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -114,7 +114,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) use timestep_ind, only:get_dt,nbinmax,decrease_dtmax,dt_too_small use timestep_sts, only:sts_get_dtau_next,use_sts,ibin_sts,sts_it_n use part, only:ibin,ibin_old,twas,iactive,ibin_wake - use part, only:metricderivs,metricderivs_ptmass + use part, only:metricderivs,metricderivs_ptmass,fext_ptmass use metric_tools, only:imet_minkowski,imetric use cons2prim, only:cons2primall,cons2primall_sink use extern_gr, only:get_grforce_all @@ -141,7 +141,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) real :: v2mean,hdti real :: dtsinksink real :: fonrmax,poti,dtphi2 - real :: fext_gas(4,npart),fext_ptmass(4,nptmass) + real :: fext_gas(4,npart) integer :: merge_ij(nptmass) integer :: merge_n real(kind=4) :: t1,t2,tcpu1,tcpu2 @@ -154,9 +154,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) ! ! set initial quantities ! - fext_gas = 0. - fext_ptmass = 0. timei = t hdtsph = 0.5*dtsph dterr = bignumber diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 1565570da..0fbed5f3b 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1077,7 +1077,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & use externalforces, only:externalforce,accrete_particles,update_externalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& - aprmassoftype,apr_level,epot_sinksink + aprmassoftype,apr_level,epot_sinksink,fext_ptmass use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,xtol,ptol use eos, only:equationofstate,ieos @@ -1110,17 +1110,16 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) real :: dtphi2,dtsinksink,fonrmax integer :: merge_ij(nptmass),merge_n - real :: fext_gas(4,npart),fext_sinks(4,nptmass) + real :: fext_gas(4,npart) pmassi = massoftype(igas) itype = igas fext_gas = 0. - fext_sinks = 0. !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- - call get_accel_sink_sink(nptmass,xyzh_ptmass,fext_sinks,epot_sinksink,dtsinksink,& + call get_accel_sink_sink(nptmass,xyzh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) !---------------------------------------------- ! predictor during substeps for gas particles @@ -1133,7 +1132,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & !$omp shared(nptmass,xyzh_ptmass,vxyz_ptmass,fxyz_ptmass) & !$omp shared(maxphase,maxp,eos_vars) & !$omp shared(bin_info,dtphi2,poti,fonrmax) & - !$omp shared(fext_gas,fext_sinks) & + !$omp shared(fext_gas,fext_ptmass) & !$omp shared(dt,hdt,xtol,ptol,aprmassoftype,apr_level) & !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass) & @@ -1187,7 +1186,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & pprev = pxyz ! calculate force between sink-gas particles call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzh_ptmass, & - fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_sinks,& + fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_ptmass,& dsdt_ptmass,fonrmax,dtphi2,bin_info) @@ -1257,7 +1256,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & enddo predictor !$omp end parallel do - call predict_gr_sink(xyzh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fext_sinks,nptmass,& + call predict_gr_sink(xyzh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fext_ptmass,nptmass,& dt,timei,hdt,metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax,& xitsmax,xerrmax) @@ -1438,7 +1437,8 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, use externalforces, only:externalforce,accrete_particles,update_externalforce use options, only:iexternalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& - massoftype,rhoh,igamma,itemp,igasP,aprmassoftype,apr_level + massoftype,rhoh,igamma,itemp,igasP,aprmassoftype,apr_level,& + fext_ptmass use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,C_force use eos, only:equationofstate,ieos @@ -1470,17 +1470,16 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) real :: dtphi2,dtsinksink,fonrmax,poti integer :: merge_ij(nptmass),merge_n - real :: fext_gas(4,npart),fext_sinks(4,nptmass) + real :: fext_gas(4,npart) pmassi = massoftype(igas) itype = igas fext_gas = 0. - fext_sinks = 0. !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_sinks,epot_sinksink,dtsinksink,& + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) dtextforce_min = min(dtextforce_min,C_force*dtsinksink) @@ -1492,7 +1491,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, !$omp shared(maxphase,maxp,aprmassoftype,apr_level) & !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass) & !$omp shared(bin_info,dtphi2,poti,fonrmax) & - !$omp shared(fext_gas,fext_sinks) & + !$omp shared(fext_gas,fext_ptmass) & !$omp private(i,accreted) & !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & !$omp private(pri,pondensi,spsoundi,tempi,dtf) & @@ -1518,7 +1517,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, pri = pondensi*dens(i) call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzmh_ptmass, & - fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_sinks,& + fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_ptmass,& dsdt_ptmass,fonrmax,dtphi2,bin_info) call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pri,fext(1:3,i),dtf) @@ -1549,7 +1548,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, enddo accreteloop !$omp enddo !$omp end parallel - call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fext_sinks,& + call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fext_ptmass,& metrics_ptmass,metricderivs_ptmass,nlive_sinks,naccreted_sinks,pxyzu_ptmass,& accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) end subroutine accrete_gr From 74cf84ef059e66009b638c2c05a4859b4fd4a970 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Mon, 16 Dec 2024 11:08:24 +1100 Subject: [PATCH 46/54] trying to fix the testgrtde --- src/setup/setup_grtde.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index f79374041..6c7370f33 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -252,7 +252,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, semia = rp/(1.-ecc_bh) period = 2.*pi*sqrt(semia**3/mass1) hacc1 = rstars(1)/1.e8 ! Something small so that set_binary doesnt warn about Roche lobe - hacc2 = rstars(2)/1.e8 + hacc2 = hacc1 ! apocentre = rp*(1.+ecc_bh)/(1.-ecc_bh) ! trueanom = acos((rp*(1.+ecc_bh)/r0 - 1.)/ecc_bh)*180./pi call set_binary(mass1,mstars(1),semia,ecc_bh,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,& @@ -363,7 +363,7 @@ subroutine write_setupfile(filename) open(newunit=iunit,file=filename,status='replace',form='formatted') write(iunit,"(a)") '# input file for tidal disruption setup' call write_inopt(provide_params,'provide_params','initial conditions',iunit) - call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)',iunit) + call write_inopt(mhole, 'mhole', 'mass of black hole (solar mass)', iunit) if (.not. provide_params) then call write_options_stars(star,relax,write_profile,ieos,iunit,nstar) write(iunit,"(/,a)") '# options for black hole and orbit' From e0c95b6f9a176e8456e217957c76b965eac62706 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Mon, 16 Dec 2024 13:33:34 +1100 Subject: [PATCH 47/54] only input xyzmh_ptmass_in of size 1:nstar --- src/setup/setup_grtde.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 6c7370f33..5e64b2efa 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -323,7 +323,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, enddo endif - call shift_stars(nstar,star,xyzmh_ptmass_in(1:3,:),vxyz_ptmass_in(1:3,:),& + call shift_stars(nstar,star,xyzmh_ptmass_in(1:3,1:nstar),vxyz_ptmass_in(1:3,1:nstar),& xyzh,vxyzu,xyzmh_ptmass,vxyz_ptmass,npart,& npartoftype,nptmass) From ed2f6938b4f8b5aba507a5b9ac0ed1c08b49773e Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Mon, 16 Dec 2024 14:11:00 +1100 Subject: [PATCH 48/54] fixed the NaN arrays in setup_grtde.f90 --- src/setup/setup_grtde.f90 | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/setup/setup_grtde.f90 b/src/setup/setup_grtde.f90 index 5e64b2efa..0957c20ea 100644 --- a/src/setup/setup_grtde.f90 +++ b/src/setup/setup_grtde.f90 @@ -115,10 +115,9 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, time = 0. polyk = 1.e-10 ! <== uconst gamma = 5./3. -! ieos = 2 angle = 0. - xyzmh_ptmass_in(:,2) = 0. - vxyz_ptmass_in(3,2) = 0. + xyzmh_ptmass_in(:,:) = 0. + vxyz_ptmass_in(:,:) = 0. if (.not.gravity) call fatal('setup','recompile with GRAVITY=yes') ! !-- space available for injected gas particles @@ -319,7 +318,7 @@ subroutine setpart(id,npart,npartoftype,xyzh,massoftype,vxyzu,polyk,gamma,hfact, else do i = 1, nstar xyzmh_ptmass_in(1:3,i) = xyzmh_ptmass_in(1:3,i) + xyzstar(:) - vxyz_ptmass_in(1:3,i) = vxyz_ptmass_in(1:3,i) + vxyzstar(:) + vxyz_ptmass_in(1:3,i) = vxyz_ptmass_in(1:3,i) + vxyzstar(:) enddo endif From 09fa42f5f64cad52a393755fe0f5b6adc6e1ccca Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 17 Dec 2024 11:41:13 +1100 Subject: [PATCH 49/54] (github actions) can run ptmass with gr --- .github/workflows/test.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 2a1dfe449..b4253371f 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -31,7 +31,7 @@ jobs: - ['test', ''] - ['testkd', ''] - ['testdust', 'dust'] - - ['testgr', 'gr'] + - ['testgr', 'gr ptmass'] - ['testgrav', 'gravity ptmass setstar'] - ['testgrowth', 'dustgrowth'] - ['testnimhd', 'nimhd'] From 70111a2f47b7634bcaab4d325b94e0e47fdb82b0 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 17 Dec 2024 11:43:30 +1100 Subject: [PATCH 50/54] (gr sink) no new ptmass arrays required anymore --- src/main/initial.F90 | 9 ++-- src/main/part.F90 | 3 -- src/main/step_leapfrog.F90 | 16 +++--- src/main/substepping.F90 | 100 ++++++++++++++++--------------------- src/tests/test_ptmass.f90 | 16 +++--- 5 files changed, 65 insertions(+), 79 deletions(-) diff --git a/src/main/initial.F90 b/src/main/initial.F90 index b9544f08f..b5689b7d9 100644 --- a/src/main/initial.F90 +++ b/src/main/initial.F90 @@ -149,7 +149,7 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) use boundary_dyn, only:dynamic_bdy,init_dynamic_bdy use substepping, only:combine_forces_gr #ifdef GR - use part, only:metricderivs,metricderivs_ptmass,metrics_ptmass,pxyzu_ptmass,fext_ptmass + use part, only:metricderivs,metricderivs_ptmass,metrics_ptmass,pxyzu_ptmass use cons2prim, only:prim2consall use eos, only:ieos use extern_gr, only:get_grforce_all,get_tmunu_all,get_tmunu_all_exact @@ -542,12 +542,11 @@ subroutine startrun(infile,logfile,evfile,dumpfile,noread) call init_metric(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass) call prim2consall(nptmass,xyzmh_ptmass,metrics_ptmass,& vxyz_ptmass,pxyzu_ptmass,use_dens=.false.,use_sink=.true.) - ! sinks in GR, provide external force due to metric to determine the sink total force - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& - iexternalforce,time,merge_ij,merge_n,dsdt_ptmass) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) - call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) + ! sinks in GR, provide external force due to metric to determine the sink total force + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass,epot_sinksink,dtsinksink,& + iexternalforce,time,merge_ij,merge_n,dsdt_ptmass) #endif dtsinksink = C_force*dtsinksink if (id==master) write(iprint,*) 'dt(sink-sink) = ',dtsinksink diff --git a/src/main/part.F90 b/src/main/part.F90 index f2553f98e..b2ecb91dc 100644 --- a/src/main/part.F90 +++ b/src/main/part.F90 @@ -193,7 +193,6 @@ module part real, allocatable :: pxyzu_ptmass(:,:) !pxyz_ptmass(maxvxyzu,maxgr) real, allocatable :: metrics_ptmass(:,:,:,:) !metrics(0:3,0:3,2,maxgr) real, allocatable :: metricderivs_ptmass(:,:,:,:) !metricderivs(0:3,0:3,3,maxgr) - real, allocatable :: fext_ptmass(:,:) ! !--sink particles ! @@ -485,7 +484,6 @@ subroutine allocate_part call allocate_array('metrics_ptmass', metrics_ptmass, 4, 4, 2, maxptmassgr) call allocate_array('metricderivs_ptmass', metricderivs_ptmass, 4, 4, 3, maxptmassgr) call allocate_array('xyzmh_ptmass', xyzmh_ptmass, nsinkproperties, maxptmass) - call allocate_array('fext_ptmass', fext_ptmass, 4, maxptmassgr) call allocate_array('vxyz_ptmass', vxyz_ptmass, 3, maxptmass) call allocate_array('fxyz_ptmass', fxyz_ptmass, 4, maxptmass) call allocate_array('fxyz_ptmass_sinksink', fxyz_ptmass_sinksink, 4, maxptmass) @@ -583,7 +581,6 @@ subroutine deallocate_part if (allocated(metrics_ptmass)) deallocate(metrics_ptmass) if (allocated(metricderivs_ptmass)) deallocate(metricderivs_ptmass) if (allocated(xyzmh_ptmass)) deallocate(xyzmh_ptmass) - if (allocated(fext_ptmass)) deallocate(fext_ptmass) if (allocated(vxyz_ptmass)) deallocate(vxyz_ptmass) if (allocated(fxyz_ptmass)) deallocate(fxyz_ptmass) if (allocated(fxyz_ptmass_sinksink)) deallocate(fxyz_ptmass_sinksink) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index a6b7faf26..55a4652d3 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -114,7 +114,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) use timestep_ind, only:get_dt,nbinmax,decrease_dtmax,dt_too_small use timestep_sts, only:sts_get_dtau_next,use_sts,ibin_sts,sts_it_n use part, only:ibin,ibin_old,twas,iactive,ibin_wake - use part, only:metricderivs,metricderivs_ptmass,fext_ptmass + use part, only:metricderivs,metricderivs_ptmass,fxyz_ptmass_sinksink use metric_tools, only:imet_minkowski,imetric use cons2prim, only:cons2primall,cons2primall_sink use extern_gr, only:get_grforce_all @@ -246,24 +246,24 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) !---------------------------------------------------------------------- call get_timings(t1,tcpu1) if (gr) then + call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) + call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) ! first calculate all the force arrays if (nptmass > 0) then call cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass) - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass_sinksink,epot_sinksink,dtsinksink,& iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) call get_grforce_all(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,& vxyz_ptmass,fxyz_ptmass,dtextforce,use_sink=.true.) - call combine_forces_gr(nptmass,fext_ptmass,fxyz_ptmass) - else + do i=1,nptmass + fxyz_ptmass(1:3,i) = fxyz_ptmass(1:3,i) + fxyz_ptmass_sinksink(1:3,i) + enddo do i=1,npart call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzmh_ptmass, & - fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fxyz_ptmass,& + fext(1,i),fext(2,i),fext(3,i),poti,pmassi,fxyz_ptmass,& dsdt_ptmass,fonrmax,dtphi2,bin_info) enddo - call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) - call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) - call combine_forces_gr(npart,fext_gas,fext) endif if ((iexternalforce > 0 .and. imetric /= imet_minkowski) .or. idamp > 0 .or. nptmass > 0 .or. & diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 0fbed5f3b..5e067f452 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1067,7 +1067,7 @@ end subroutine get_external_force_gas !---------------------------------------------------------------- subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & dens,metrics,metricderivs,& - xyzh_ptmass,vxyz_ptmass,fxyz_ptmass,& + xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& metrics_ptmass,metricderivs_ptmass,pxyzu_ptmass,& pitsmax,perrmax,& xitsmax,xerrmax,dtextforcenew) @@ -1077,7 +1077,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & use externalforces, only:externalforce,accrete_particles,update_externalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& - aprmassoftype,apr_level,epot_sinksink,fext_ptmass + aprmassoftype,apr_level,epot_sinksink,fxyz_ptmass_sinksink,dsdt_ptmass use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,xtol,ptol use eos, only:equationofstate,ieos @@ -1090,7 +1090,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & real, intent(inout) :: xyzh(:,:),vxyzu(:,:),fext(:,:),pxyzu(:,:),dens(:),metrics(:,:,:,:),metricderivs(:,:,:,:) - real, intent(inout) :: xyzh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:) real, intent(in) :: dt,hdt,timei integer, intent(in) :: npart,ntypes,nptmass @@ -1107,19 +1107,17 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & ! real, save :: dmdt = 0. logical :: converged real :: rhoi,hi,eni,uui,densi,poti - real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) + real :: bin_info(6,nptmass) real :: dtphi2,dtsinksink,fonrmax integer :: merge_ij(nptmass),merge_n - real :: fext_gas(4,npart) pmassi = massoftype(igas) itype = igas - fext_gas = 0. !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- - call get_accel_sink_sink(nptmass,xyzh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass_sinksink,epot_sinksink,dtsinksink,& iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) !---------------------------------------------- ! predictor during substeps for gas particles @@ -1129,10 +1127,10 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & ! !$omp parallel do default(none) & !$omp shared(npart,xyzh,vxyzu,fext,iphase,ntypes,massoftype) & - !$omp shared(nptmass,xyzh_ptmass,vxyz_ptmass,fxyz_ptmass) & + !$omp shared(nptmass,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass) & !$omp shared(maxphase,maxp,eos_vars) & !$omp shared(bin_info,dtphi2,poti,fonrmax) & - !$omp shared(fext_gas,fext_ptmass) & + !$omp shared(fxyz_ptmass_sinksink) & !$omp shared(dt,hdt,xtol,ptol,aprmassoftype,apr_level) & !$omp shared(ieos,pxyzu,dens,metrics,metricderivs,ien_type) & !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass) & @@ -1184,18 +1182,16 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & pmom_iterations: do while (its <= itsmax .and. .not. converged) its = its + 1 pprev = pxyz - ! calculate force between sink-gas particles - call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzh_ptmass, & - fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_ptmass,& - dsdt_ptmass,fonrmax,dtphi2,bin_info) - - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - call combine_forces_gr_one(fext_gas(1:3,i),fstar(1:3)) + + ! calculate force between sink-gas particles + call get_accel_sink_gas(nptmass,xyz(1),xyz(2),xyz(3),hi,xyzmh_ptmass, & + fstar(1),fstar(2),fstar(3),poti,pmassi,fxyz_ptmass,& + dsdt_ptmass,fonrmax,dtphi2,bin_info) pxyz = pprev + hdt*(fstar - fexti) pmom_err = maxval(abs(pxyz - pprev)) @@ -1256,7 +1252,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & enddo predictor !$omp end parallel do - call predict_gr_sink(xyzh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fext_ptmass,nptmass,& + call predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,nptmass,& dt,timei,hdt,metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax,& xitsmax,xerrmax) @@ -1267,27 +1263,20 @@ end subroutine predict_gr ! routine for prediction substep in GR case !+ !---------------------------------------------------------------- -subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fext_sinks,nptmass,dt,timei,hdt, & +subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,nptmass,dt,timei,hdt, & metrics,metricderivs,dtextforcenew,pitsmax,perrmax, & xitsmax,xerrmax) - use dim, only:maxptmass,maxp,maxvxyzu + use dim, only:maxptmass use io, only:master,warning,fatal - use externalforces, only:externalforce,accrete_particles,update_externalforce - use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& - massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,epot_sinksink,& - dsdt_ptmass - use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete + use part, only:epot_sinksink,dsdt_ptmass use timestep, only:bignumber,xtol,ptol - use eos, only:equationofstate,ieos use cons2primsolver,only:conservative2primitive use extern_gr, only:get_grforce use metric_tools, only:pack_metric,pack_metricderivs - use damping, only:calc_damp,apply_damp use ptmass, only:get_accel_sink_sink - use options, only:iexternalforce - real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fext(:,:),pxyzu_ptmass(:,:) - real, intent(inout) :: metrics(:,:,:,:),metricderivs(:,:,:,:),dtextforcenew,fext_sinks(:,:) + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),fxyz_ptmass_sinksink(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: metrics(:,:,:,:),metricderivs(:,:,:,:),dtextforcenew real, intent(in) :: dt,hdt,timei integer, intent(in) :: nptmass,ntypes integer, intent(inout) :: pitsmax,xitsmax @@ -1313,11 +1302,10 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex ! predictor step for external forces, also recompute external forces ! !$omp parallel do default(none) & - !$omp shared(xyzmh_ptmass,vxyz_ptmass,fext,iphase,ntypes,massoftype) & - !$omp shared(maxphase,maxp,eos_vars) & + !$omp shared(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink) & !$omp shared(dt,hdt,xtol,ptol,nptmass) & - !$omp shared(ieos,pxyzu_ptmass,metrics,metricderivs,ien_type) & - !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass,iexternalforce,fext_sinks) & + !$omp shared(pxyzu_ptmass,metrics,metricderivs) & + !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass) & !$omp private(i,its,tempi,rhoi,hi,eni,uui,densi,xyzhi) & !$omp private(converged,pmom_err,x_err,pri,ierr,gammai,pmassi) & !$omp reduction(max:xitsmax,pitsmax,perrmax,xerrmax) & @@ -1334,7 +1322,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex xyz(2) = xyzhi(2) xyz(3) = xyzhi(3) xyzhi(4) = hi - if (.not.isdead_or_accreted(hi)) then + if (pmassi >= 0) then its = 0 converged = .false. ! @@ -1344,7 +1332,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex eni = 0. vxyz(1:3) = vxyz_ptmass(1:3,i) uui = 0. - fexti = fext(:,i) + fexti = fxyz_ptmass(:,i) pxyz = pxyz + hdt*fexti !-- unpack thermo variables for the first guess in cons2prim @@ -1359,12 +1347,13 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex its = its + 1 pprev = pxyz call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& - tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + tempi,gammai,rhoi,pxyz,eni,ierr,1) if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - call combine_forces_gr_one(fext_sinks(1:3,i),fstar(1:3)) + + fstar = fstar + fxyz_ptmass_sinksink(:,i) pxyz = pprev + hdt*(fstar - fexti) pmom_err = maxval(abs(pxyz - pprev)) @@ -1377,7 +1366,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex perrmax = max(pmom_err,perrmax) call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& - gammai,rhoi,pxyz,eni,ierr,ien_type) + gammai,rhoi,pxyz,eni,ierr,1) if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) xyz = xyz + dt*vxyz @@ -1395,7 +1384,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex its = its+1 xyz_prev = xyz call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& - pri,tempi,gammai,rhoi,pxyz,eni,ierr,ien_type) + pri,tempi,gammai,rhoi,pxyz,eni,ierr,1) if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) xyz = xyz_prev + hdt*(vxyz_star - vxyz) x_err = maxval(abs(xyz-xyz_prev)) @@ -1413,7 +1402,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fext,fex xyzmh_ptmass(1:3,i) = xyz(1:3) pxyzu_ptmass(1:3,i) = pxyz(1:3) vxyz_ptmass(1:3,i) = vxyz(1:3) - fext(:,i) = fexti + fxyz_ptmass(:,i) = fexti endif enddo predictor @@ -1438,7 +1427,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, use options, only:iexternalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& massoftype,rhoh,igamma,itemp,igasP,aprmassoftype,apr_level,& - fext_ptmass + fxyz_ptmass_sinksink use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,C_force use eos, only:equationofstate,ieos @@ -1479,7 +1468,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- - call get_accel_sink_sink(nptmass,xyzmh_ptmass,fext_ptmass,epot_sinksink,dtsinksink,& + call get_accel_sink_sink(nptmass,xyzmh_ptmass,fxyz_ptmass_sinksink,epot_sinksink,dtsinksink,& iexternalforce,timei,merge_ij,merge_n,dsdt_ptmass) dtextforce_min = min(dtextforce_min,C_force*dtsinksink) @@ -1491,7 +1480,6 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, !$omp shared(maxphase,maxp,aprmassoftype,apr_level) & !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass) & !$omp shared(bin_info,dtphi2,poti,fonrmax) & - !$omp shared(fext_gas,fext_ptmass) & !$omp private(i,accreted) & !$omp shared(ieos,dens,pxyzu,iexternalforce,C_force) & !$omp private(pri,pondensi,spsoundi,tempi,dtf) & @@ -1516,13 +1504,11 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, call equationofstate(ieos,pondensi,spsoundi,dens(i),xyzh(1,i),xyzh(2,i),xyzh(3,i),tempi,vxyzu(4,i)) pri = pondensi*dens(i) + call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pri,fext(1:3,i),dtf) call get_accel_sink_gas(nptmass,xyzh(1,i),xyzh(2,i),xyzh(3,i),xyzh(4,i),xyzmh_ptmass, & - fext_gas(1,i),fext_gas(2,i),fext_gas(3,i),poti,pmassi,fext_ptmass,& + fext(1,i),fext(2,i),fext(3,i),poti,pmassi,fxyz_ptmass,& dsdt_ptmass,fonrmax,dtphi2,bin_info) - call get_grforce(xyzh(:,i),metrics(:,:,:,i),metricderivs(:,:,:,i),vxyzu(1:3,i),dens(i),vxyzu(4,i),pri,fext(1:3,i),dtf) - call combine_forces_gr_one(fext_gas(1:3,i),fext(1:3,i)) - dtextforce_min = min(dtextforce_min,C_force*dtf,C_force*sqrt(dtphi2)) if (idamp > 0) then @@ -1548,7 +1534,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, enddo accreteloop !$omp enddo !$omp end parallel - call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fext_ptmass,& + call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,& metrics_ptmass,metricderivs_ptmass,nlive_sinks,naccreted_sinks,pxyzu_ptmass,& accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) end subroutine accrete_gr @@ -1558,7 +1544,7 @@ end subroutine accrete_gr ! routine for accretion step in GR case !+ !---------------------------------------------------------------- -subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptmass,metricderivs_ptmass,& +subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,metrics_ptmass,metricderivs_ptmass,& nlive_sinks,naccreted_sinks,& pxyzu_ptmass,accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) use part, only:ihsoft @@ -1567,8 +1553,8 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptma use timestep, only:bignumber,C_force use cons2primsolver,only:conservative2primitive use extern_gr, only:get_grforce - real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fext(:,:),pxyzu_ptmass(:,:) - real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),fext_sinks(:,:) + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),fxyz_ptmass_sinksink(:,:) integer, intent(in) :: nptmass integer, intent(inout) :: nlive_sinks,naccreted_sinks real, intent(inout) :: accretedmass @@ -1583,8 +1569,8 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptma integer, parameter :: itsmax = 50 !$omp parallel default(none) & - !$omp shared(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,vxyz_ptmass,fext,hdt,timei) & - !$omp shared(dtsinksink,fext_sinks) & + !$omp shared(nptmass,xyzmh_ptmass,metrics_ptmass,metricderivs_ptmass,vxyz_ptmass,fxyz_ptmass,hdt,timei) & + !$omp shared(dtsinksink,fxyz_ptmass_sinksink) & !$omp private(i,accreted) & !$omp shared(pxyzu_ptmass,iexternalforce,C_force) & !$omp private(dtf,xyzhi,hsofti,pmassi,pri,densi) & @@ -1609,14 +1595,16 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fext,fext_sinks,metrics_ptma hsofti = xyzmh_ptmass(ihsoft,i) xyzhi(4) = huge(0.) if (hsofti > 0.) xyzhi(4) = hsofti - call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),densi,0.,pri,fext(1:3,i),dtf) - call combine_forces_gr_one(fext_sinks(1:3,i),fext(1:3,i)) + call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),& + densi,0.,pri,fxyz_ptmass(1:3,i),dtf) + + fxyz_ptmass(:,i) = fxyz_ptmass(:,i) + fxyz_ptmass_sinksink(:,i) dtextforce_min = min(dtextforce_min,C_force*dtf) ! ! correct v to the full step using only the external force ! - pxyzu_ptmass(1:3,i) = pxyzu_ptmass(1:3,i) + hdt*fext(1:3,i) + pxyzu_ptmass(1:3,i) = pxyzu_ptmass(1:3,i) + hdt*fxyz_ptmass(1:3,i) if (iexternalforce > 0) then ! diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index 758fabb4d..cc815792d 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -85,7 +85,6 @@ subroutine test_ptmass(ntests,npass,string) do_test_HII = .true. case('ptmassSDAR') do_test_SDAR = .true. - case default testall = .true. end select @@ -96,6 +95,14 @@ subroutine test_ptmass(ntests,npass,string) gamma = 1. iexternalforce = 0 alpha = 0.01 + ! + ! Test for sink particles in GR + ! + if ((do_test_binary_gr .or. testall) .and. gr) then + call test_sink_binary_gr(ntests,npass,string) + return + endif + do itest=istart,2 ! ! select order of integration @@ -123,14 +130,10 @@ subroutine test_ptmass(ntests,npass,string) ! ! Test sink particle mergers ! - if ((do_test_binary_gr .or. testall) .and. gr) call test_merger(ntests,npass) + if (do_test_merger .or. testall) call test_merger(ntests,npass) enddo ! - ! Test for sink particles in GR - ! - if (do_test_binary_gr) call test_sink_binary_gr(ntests,npass,string) - ! ! Test of sink particle potentials ! if (do_test_potential .or. testall) call test_sink_potential(ntests,npass) @@ -276,7 +279,6 @@ subroutine test_binary(ntests,npass,string) C_force = 0.25 if (itest==3) C_force = 0.25 omega = sqrt((m1+m2)/a**3) - t = 0. call set_units(mass=1.d0,dist=1.d0,G=1.d0) call set_binary(m1,m2,a,ecc,hacc1,hacc2,xyzmh_ptmass,vxyz_ptmass,nptmass,ierr,verbose=.false.) if (ierr /= 0) nerr = nerr + 1 From ec3558c4654886b415b0e0697758d1a3ac89bc04 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 17 Dec 2024 12:02:47 +1100 Subject: [PATCH 51/54] (gr sink) fix grav wave test --- src/tests/test_ptmass.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/src/tests/test_ptmass.f90 b/src/tests/test_ptmass.f90 index cc815792d..70668904d 100644 --- a/src/tests/test_ptmass.f90 +++ b/src/tests/test_ptmass.f90 @@ -277,6 +277,7 @@ subroutine test_binary(ntests,npass,string) hacc1 = 0.35 hacc2 = 0.35 C_force = 0.25 + t = 0. if (itest==3) C_force = 0.25 omega = sqrt((m1+m2)/a**3) call set_units(mass=1.d0,dist=1.d0,G=1.d0) From 025de37755088d27ec887bdeb528f4850fbcdf41 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Tue, 17 Dec 2024 15:04:17 +1100 Subject: [PATCH 52/54] (gr sink) was accessing the 4th array component of fxyz_ptmass when its not needed --- src/main/substepping.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 5e067f452..a54e4693b 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1332,7 +1332,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm eni = 0. vxyz(1:3) = vxyz_ptmass(1:3,i) uui = 0. - fexti = fxyz_ptmass(:,i) + fexti = fxyz_ptmass(1:3,i) pxyz = pxyz + hdt*fexti !-- unpack thermo variables for the first guess in cons2prim @@ -1353,7 +1353,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) - fstar = fstar + fxyz_ptmass_sinksink(:,i) + fstar = fstar + fxyz_ptmass_sinksink(1:3,i) pxyz = pprev + hdt*(fstar - fexti) pmom_err = maxval(abs(pxyz - pprev)) @@ -1401,8 +1401,8 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm ! re-pack arrays back where they belong xyzmh_ptmass(1:3,i) = xyz(1:3) pxyzu_ptmass(1:3,i) = pxyz(1:3) - vxyz_ptmass(1:3,i) = vxyz(1:3) - fxyz_ptmass(:,i) = fexti + vxyz_ptmass(1:3,i) = vxyz(1:3) + fxyz_ptmass(1:3,i) = fexti endif enddo predictor From 23954b62b1dac45d0d6f851c74fd26bb61694de3 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Wed, 18 Dec 2024 11:44:50 +1100 Subject: [PATCH 53/54] (gr sink) cleaning the file so that variable names are consistent for ptmass --- src/main/substepping.F90 | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index a54e4693b..5239a462b 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -1264,7 +1264,7 @@ end subroutine predict_gr !+ !---------------------------------------------------------------- subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,nptmass,dt,timei,hdt, & - metrics,metricderivs,dtextforcenew,pitsmax,perrmax, & + metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax, & xitsmax,xerrmax) use dim, only:maxptmass use io, only:master,warning,fatal @@ -1276,7 +1276,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm use ptmass, only:get_accel_sink_sink real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),fxyz_ptmass_sinksink(:,:),pxyzu_ptmass(:,:) - real, intent(inout) :: metrics(:,:,:,:),metricderivs(:,:,:,:),dtextforcenew + real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),dtextforcenew real, intent(in) :: dt,hdt,timei integer, intent(in) :: nptmass,ntypes integer, intent(inout) :: pitsmax,xitsmax @@ -1304,7 +1304,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm !$omp parallel do default(none) & !$omp shared(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink) & !$omp shared(dt,hdt,xtol,ptol,nptmass) & - !$omp shared(pxyzu_ptmass,metrics,metricderivs) & + !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass) & !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass) & !$omp private(i,its,tempi,rhoi,hi,eni,uui,densi,xyzhi) & !$omp private(converged,pmom_err,x_err,pri,ierr,gammai,pmassi) & @@ -1346,12 +1346,12 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm pmom_iterations: do while (its <= itsmax .and. .not. converged) its = its + 1 pprev = pxyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,& + call conservative2primitive(xyz,metrics_ptmass(:,:,:,i),vxyz,densi,uui,pri,& tempi,gammai,rhoi,pxyz,eni,ierr,1) if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) - call get_grforce(xyzhi,metrics(:,:,:,i),metricderivs(:,:,:,i),vxyz,densi,uui,pri,fstar) + call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz,densi,uui,pri,fstar) fstar = fstar + fxyz_ptmass_sinksink(1:3,i) @@ -1365,12 +1365,12 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm pitsmax = max(its,pitsmax) perrmax = max(pmom_err,perrmax) - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz,densi,uui,pri,tempi,& + call conservative2primitive(xyz,metrics_ptmass(:,:,:,i),vxyz,densi,uui,pri,tempi,& gammai,rhoi,pxyz,eni,ierr,1) if (ierr > 0) call warning('cons2primsolver [in substep_gr (b)]','enthalpy did not converge',i=i) xyz = xyz + dt*vxyz - call pack_metric(xyz,metrics(:,:,:,i)) + call pack_metric(xyz,metrics_ptmass(:,:,:,i)) its = 0 converged = .false. @@ -1383,7 +1383,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm xyz_iterations: do while (its <= itsmax .and. .not. converged) its = its+1 xyz_prev = xyz - call conservative2primitive(xyz,metrics(:,:,:,i),vxyz_star,densi,uui,& + call conservative2primitive(xyz,metrics_ptmass(:,:,:,i),vxyz_star,densi,uui,& pri,tempi,gammai,rhoi,pxyz,eni,ierr,1) if (ierr > 0) call warning('cons2primsolver [in substep_gr (c)]','enthalpy did not converge',i=i) xyz = xyz_prev + hdt*(vxyz_star - vxyz) @@ -1391,9 +1391,9 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm if (x_err < xtol) converged = .true. vxyz = vxyz_star ! UPDATE METRIC HERE - call pack_metric(xyz,metrics(:,:,:,i)) + call pack_metric(xyz,metrics_ptmass(:,:,:,i)) enddo xyz_iterations - call pack_metricderivs(xyz,metricderivs(:,:,:,i)) + call pack_metricderivs(xyz,metricderivs_ptmass(:,:,:,i)) if (its > itsmax ) call warning('substep_gr','Reached max number of x iterations. x_err ',val=x_err) xitsmax = max(its,xitsmax) xerrmax = max(x_err,xerrmax) @@ -1459,12 +1459,9 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, real :: bin_info(6,nptmass),dsdt_ptmass(3,nptmass) real :: dtphi2,dtsinksink,fonrmax,poti integer :: merge_ij(nptmass),merge_n - real :: fext_gas(4,npart) pmassi = massoftype(igas) itype = igas - fext_gas = 0. - !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- From 74cad0c652bef68ca6b101256f3e2536aa71fc74 Mon Sep 17 00:00:00 2001 From: Megha Sharma Date: Wed, 18 Dec 2024 16:07:41 +1100 Subject: [PATCH 54/54] (gr sink) fixed the error in test gr ptmass binary case --- src/main/step_leapfrog.F90 | 2 +- src/main/substepping.F90 | 45 ++++++++++++++++++++++---------------- 2 files changed, 27 insertions(+), 20 deletions(-) diff --git a/src/main/step_leapfrog.F90 b/src/main/step_leapfrog.F90 index 55a4652d3..032b5a865 100644 --- a/src/main/step_leapfrog.F90 +++ b/src/main/step_leapfrog.F90 @@ -248,7 +248,7 @@ subroutine step(npart,nactive,t,dtsph,dtextforce,dtnew) if (gr) then call cons2primall(npart,xyzh,metrics,pxyzu,vxyzu,dens,eos_vars) call get_grforce_all(npart,xyzh,metrics,metricderivs,vxyzu,fext,dtextforce,dens=dens) - ! first calculate all the force arrays + ! first calculate all the force arrays on sink particles if (nptmass > 0) then call cons2primall_sink(nptmass,xyzmh_ptmass,metrics_ptmass,pxyzu_ptmass,vxyz_ptmass) diff --git a/src/main/substepping.F90 b/src/main/substepping.F90 index 5239a462b..8cb7382c6 100644 --- a/src/main/substepping.F90 +++ b/src/main/substepping.F90 @@ -197,7 +197,6 @@ subroutine substep_gr(npart,nptmass,ntypes,dtsph,dtextforce,xyzh,vxyzu,pxyzu,den naccreted = 0 nlive = 0 dtextforce_min = bignumber - call accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted,& pxyzu,accretedmass,hdt,npart,nptmass,& ntypes,dtextforce_min,timei,xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,& @@ -1076,8 +1075,9 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & use io, only:master,warning,fatal use externalforces, only:externalforce,accrete_particles,update_externalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& - massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& - aprmassoftype,apr_level,epot_sinksink,fxyz_ptmass_sinksink,dsdt_ptmass + massoftype,rhoh,ien_type,eos_vars,igamma,itemp,igasP,& + aprmassoftype,apr_level,epot_sinksink,fxyz_ptmass_sinksink,dsdt_ptmass,& + fsink_old use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,xtol,ptol use eos, only:equationofstate,ieos @@ -1113,7 +1113,8 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & pmassi = massoftype(igas) itype = igas - + fsink_old = fxyz_ptmass + fxyz_ptmass = 0. !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- @@ -1252,7 +1253,7 @@ subroutine predict_gr(xyzh,vxyzu,ntypes,pxyzu,fext,npart,nptmass,dt,timei,hdt, & enddo predictor !$omp end parallel do - call predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,nptmass,& + call predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fsink_old,fxyz_ptmass,fxyz_ptmass_sinksink,nptmass,& dt,timei,hdt,metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax,& xitsmax,xerrmax) @@ -1263,7 +1264,8 @@ end subroutine predict_gr ! routine for prediction substep in GR case !+ !---------------------------------------------------------------- -subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,nptmass,dt,timei,hdt, & +subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fsink_old,fxyz_ptmass,& + fxyz_ptmass_sinksink,nptmass,dt,timei,hdt, & metrics_ptmass,metricderivs_ptmass,dtextforcenew,pitsmax,perrmax, & xitsmax,xerrmax) use dim, only:maxptmass @@ -1276,7 +1278,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm use ptmass, only:get_accel_sink_sink real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),fxyz_ptmass_sinksink(:,:),pxyzu_ptmass(:,:) - real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),dtextforcenew + real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),dtextforcenew,fsink_old(:,:) real, intent(in) :: dt,hdt,timei integer, intent(in) :: nptmass,ntypes integer, intent(inout) :: pitsmax,xitsmax @@ -1304,7 +1306,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm !$omp parallel do default(none) & !$omp shared(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink) & !$omp shared(dt,hdt,xtol,ptol,nptmass) & - !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass) & + !$omp shared(pxyzu_ptmass,metrics_ptmass,metricderivs_ptmass,fsink_old) & !$omp shared(dtsinksink,epot_sinksink,merge_ij,merge_n,dsdt_ptmass) & !$omp private(i,its,tempi,rhoi,hi,eni,uui,densi,xyzhi) & !$omp private(converged,pmom_err,x_err,pri,ierr,gammai,pmassi) & @@ -1332,7 +1334,7 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm eni = 0. vxyz(1:3) = vxyz_ptmass(1:3,i) uui = 0. - fexti = fxyz_ptmass(1:3,i) + fexti = fsink_old(1:3,i) pxyz = pxyz + hdt*fexti !-- unpack thermo variables for the first guess in cons2prim @@ -1352,8 +1354,9 @@ subroutine predict_gr_sink(xyzmh_ptmass,vxyz_ptmass,ntypes,pxyzu_ptmass,fxyz_ptm if (ierr > 0) call warning('cons2primsolver [in substep_gr (a)]','enthalpy did not converge',i=i) call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz,densi,uui,pri,fstar) - - fstar = fstar + fxyz_ptmass_sinksink(1:3,i) + + ! add forces from curvature on sink, from sink sink interaction and sink-gas interaction + fstar = fstar + fxyz_ptmass_sinksink(1:3,i) + fxyz_ptmass(1:3,i) pxyz = pprev + hdt*(fstar - fexti) pmom_err = maxval(abs(pxyz - pprev)) @@ -1427,7 +1430,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, use options, only:iexternalforce use part, only:maxphase,isdead_or_accreted,iamboundary,igas,iphase,iamtype,& massoftype,rhoh,igamma,itemp,igasP,aprmassoftype,apr_level,& - fxyz_ptmass_sinksink + fxyz_ptmass_sinksink,fsink_old use io_summary, only:summary_variable,iosumextr,iosumextt,summary_accrete use timestep, only:bignumber,C_force use eos, only:equationofstate,ieos @@ -1462,6 +1465,8 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, pmassi = massoftype(igas) itype = igas + fsink_old = fxyz_ptmass + fxyz_ptmass = 0. !---------------------------------------------- ! calculate acceleration sink-sink !---------------------------------------------- @@ -1531,7 +1536,7 @@ subroutine accrete_gr(xyzh,vxyzu,dens,fext,metrics,metricderivs,nlive,naccreted, enddo accreteloop !$omp enddo !$omp end parallel - call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,& + call accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fsink_old,fxyz_ptmass,fxyz_ptmass_sinksink,& metrics_ptmass,metricderivs_ptmass,nlive_sinks,naccreted_sinks,pxyzu_ptmass,& accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) end subroutine accrete_gr @@ -1541,7 +1546,7 @@ end subroutine accrete_gr ! routine for accretion step in GR case !+ !---------------------------------------------------------------- -subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sinksink,metrics_ptmass,metricderivs_ptmass,& +subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fsink_old,fxyz_ptmass,fxyz_ptmass_sinksink,metrics_ptmass,metricderivs_ptmass,& nlive_sinks,naccreted_sinks,& pxyzu_ptmass,accretedmass,hdt,nptmass,dtextforce_min,timei,dtsinksink) use part, only:ihsoft @@ -1550,7 +1555,7 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sink use timestep, only:bignumber,C_force use cons2primsolver,only:conservative2primitive use extern_gr, only:get_grforce - real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:) + real, intent(inout) :: xyzmh_ptmass(:,:),vxyz_ptmass(:,:),fxyz_ptmass(:,:),pxyzu_ptmass(:,:),fsink_old(:,:) real, intent(inout) :: metrics_ptmass(:,:,:,:),metricderivs_ptmass(:,:,:,:),fxyz_ptmass_sinksink(:,:) integer, intent(in) :: nptmass integer, intent(inout) :: nlive_sinks,naccreted_sinks @@ -1590,11 +1595,14 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sink ! a softening length is set ! hsofti = xyzmh_ptmass(ihsoft,i) - xyzhi(4) = huge(0.) + xyzhi(4) = xyzmh_ptmass(5,i) if (hsofti > 0.) xyzhi(4) = hsofti + ! add force from sink-gas interaction to the sink-sink interaction array + fxyz_ptmass_sinksink(:,i) = fxyz_ptmass_sinksink(:,i) + fxyz_ptmass(:,i) + ! calculate force due to curvature call get_grforce(xyzhi,metrics_ptmass(:,:,:,i),metricderivs_ptmass(:,:,:,i),vxyz_ptmass(1:3,i),& densi,0.,pri,fxyz_ptmass(1:3,i),dtf) - + ! get total force on sinks fxyz_ptmass(:,i) = fxyz_ptmass(:,i) + fxyz_ptmass_sinksink(:,i) dtextforce_min = min(dtextforce_min,C_force*dtf) @@ -1602,8 +1610,7 @@ subroutine accrete_gr_sink(xyzmh_ptmass,vxyz_ptmass,fxyz_ptmass,fxyz_ptmass_sink ! correct v to the full step using only the external force ! pxyzu_ptmass(1:3,i) = pxyzu_ptmass(1:3,i) + hdt*fxyz_ptmass(1:3,i) - - if (iexternalforce > 0) then + if (pmassi < 0.) then ! ! sending the mass twice here is deliberate, as an accreted sink particle is indicated by ! a negative mass, unlike gas particles which are flagged with a negative smoothing length