Skip to content
This repository was archived by the owner on Aug 28, 2024. It is now read-only.

Commit

Permalink
Finished major restructuring of data types. It now compiles.
Browse files Browse the repository at this point in the history
  • Loading branch information
@daminton
daminton committed Jul 6, 2021
1 parent 69acd29 commit f8c3dec
Show file tree
Hide file tree
Showing 10 changed files with 171 additions and 154 deletions.
18 changes: 12 additions & 6 deletions Makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ lib:
ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
ln -s $(SWIFTEST_HOME)/Makefile .; \
make libdir
cd $(SWIFTEST_HOME)/src/driftkick; \
cd $(SWIFTEST_HOME)/src/drift; \
rm -f Makefile.Defines Makefile; \
ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
ln -s $(SWIFTEST_HOME)/Makefile .; \
Expand All @@ -106,6 +106,11 @@ lib:
ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
ln -s $(SWIFTEST_HOME)/Makefile .; \
make libdir
cd $(SWIFTEST_HOME)/src/kick; \
rm -f Makefile.Defines Makefile; \
ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
ln -s $(SWIFTEST_HOME)/Makefile .; \
make libdir
cd $(SWIFTEST_HOME)/src/obl; \
rm -f Makefile.Defines Makefile; \
ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
Expand Down Expand Up @@ -179,20 +184,21 @@ bin: *.f90
clean:
cd $(SWIFTEST_HOME)/src/modules; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/discard; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/driftkick; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/drift; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/eucl; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/gr; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/helio; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/io; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/kick; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/main; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/obl; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/operators; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/orbel; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/rmvs; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/setup; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/util; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/user; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/main; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/util; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/whm; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/rmvs; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/src/helio; rm -f Makefile.Defines Makefile *.gc*
cd $(SWIFTEST_HOME)/bin; rm -f swiftest_*
cd $(SWIFTEST_HOME)/bin; rm -f tool_*
cd $(SWIFTEST_HOME)/lib; rm -f lib*
Expand Down
0 src/driftkick/drift.f90 → src/drift/drift.f90
View file
File renamed without changes.
44 changes: 19 additions & 25 deletions src/helio/helio_getacch.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,16 +21,13 @@ module subroutine helio_getacch_pl(self, system, param, t)
real(DP), dimension(:), allocatable, save :: irh
real(DP), dimension(:, :), allocatable, save :: xh_loc, aobl

associate(pl => self, npl => self%nbody)
!if (lflag) then
pl%ahi(:,2:npl) = 0.0_DP
call helio_getacch_int_pl(pl, t)
!end if
!if (param%loblatecb) call self%obl_acc(cb) TODO: Fix this
!else
associate(cb => system%cb, pl => self, npl => self%nbody)
pl%ahi(:,2:npl) = 0.0_DP
call helio_getacch_int_pl(pl, t)
pl%ah(:,:) = pl%ahi(:,:)
!end if
if (param%loblatecb) call pl%obl_acc(cb)
if (param%lextra_force) call pl%user_getacch(system, param, t)
if (param%lgr) call pl%gr_getacch(param)
end associate

return
Expand All @@ -56,18 +53,15 @@ module subroutine helio_getacch_tp(self, system, param, t, xhp)
real(DP) :: r2, mu
real(DP), dimension(:), allocatable, save :: irh, irht

! executable code
associate(tp => self, ntp => self%nbody, npl => system%pl%nbody)
associate(tp => self, ntp => self%nbody, cb => system%cb, pl => system%pl, npl => system%pl%nbody)
select type(pl => system%pl)
class is (rmvs_pl)
!if (lflag) then
self%ahi(:,:) = 0.0_DP
call helio_getacch_int_tp(tp, pl, t, xhp)
!end if
!if (param%loblatecb) call self%obl_acc(cb) TODO: Fix this
class is (helio_pl)
self%ahi(:,:) = 0.0_DP
call helio_getacch_int_tp(tp, pl, t, xhp)
tp%ah(:,:) = tp%ahi(:,:)
if (param%loblatecb) call tp%obl_acc(cb)
if (param%lextra_force) call tp%user_getacch(system, param, t)
if (param%lgr) call tp%gr_getacch(system, param)
if (param%lgr) call tp%gr_getacch(param)
end select
end associate
return
Expand Down Expand Up @@ -95,10 +89,10 @@ subroutine helio_getacch_int_pl(pl, t)
dx(:) = pl%xh(:,j) - pl%xh(:,i)
rji2 = dot_product(dx(:), dx(:))
irij3 = 1.0_DP / (rji2 * sqrt(rji2))
faci = self%Gmass(i) * irij3
facj = self%Gmass(j) * irij3
self%ahi(:,i) = self%ahi(:,i) + facj * dx(:)
self%ahi(:,i) = self%ahi(:,j) - faci * dx(:)
faci = pl%Gmass(i) * irij3
facj = pl%Gmass(j) * irij3
pl%ahi(:,i) = pl%ahi(:,i) + facj * dx(:)
pl%ahi(:,i) = pl%ahi(:,j) - faci * dx(:)
end do
end do
end associate
Expand All @@ -115,10 +109,10 @@ subroutine helio_getacch_int_tp(tp, pl, t, xhp)
!! Adapted from Hal Levison's Swift routine getacch_ah3_tp.f
implicit none
! Arguments
class(helio_tp), intent(inout) :: tp !! Helio test particle data structure
class(helio_pl), intent(inout) :: pl !! Helio massive body particle data structure
real(DP), intent(in) :: t !! Current time
real(DP), dimension(:,:), intent(in) :: xhp !! Heliocentric positions of planets
class(helio_tp), intent(inout) :: tp !! Helio test particle data structure
class(swiftest_pl), intent(inout) :: pl !! Helio massive body particle data structure
real(DP), intent(in) :: t !! Current time
real(DP), dimension(:,:), intent(in) :: xhp !! Heliocentric positions of planets
! Internals
integer(I4B) :: i, j
real(DP) :: r2, fac
Expand Down
87 changes: 45 additions & 42 deletions src/helio/helio_step.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,22 +17,22 @@ module subroutine helio_step_system(self, param, t, dt)

select type(system => self)
class is (helio_nbody_system)
select type(cb => self%cb)
class is (helio_cb)
select type(pl => self%pl)
class is (helio_pl)
select type(tp => self%tp)
class is (helio_tp)
call pl%set_rhill(cb)
call tp%set_beg_end(xbeg = pl%xh)
call pl%step(system, param, t, dt)
if (ntp > 0) then
call tp%set_beg_end(xend = pl%xh)
call tp%step(system, param, t, dt)
end if
end select
end select
end select
select type(cb => self%cb)
class is (helio_cb)
select type(pl => self%pl)
class is (helio_pl)
select type(tp => self%tp)
class is (helio_tp)
call pl%set_rhill(cb)
call system%set_beg_end(xbeg = pl%xh)
call pl%step(system, param, t, dt)
if (tp%nbody > 0) then
call system%set_beg_end(xend = pl%xh)
call tp%step(system, param, t, dt)
end if
end select
end select
end select
end select
return
end subroutine helio_step_system
Expand All @@ -57,28 +57,29 @@ module subroutine helio_step_pl(self, system, param, t, dt)
real(DP), dimension(NDIM) :: ptbeg, ptend !! TODO: Incorporate these into the tp structure
logical, save :: lfirst = .true.

associate(cb => system%cb)
associate(pl => self, cb => system%cb)
dth = 0.5_DP * dt
if (lfirst) then
call self%vh2vb(cb)
call pl%vh2vb(cb)
lfirst = .false.
end if
call self%lindrift(cb, dth, ptbeg)
call self%getacch(system, param, t)
call self%kickvb(dth)
call pl%lindrift(cb, dth, ptbeg)
call pl%getacch(system, param, t)
call pl%kickvb(dth)

call self%drift(system, param, dt)
call self%getacch(system, param, t + dt)
call self%kickvb(dth)
call self%lindrift(cb, dth, ptend)
call self%vb2vh(cb)
call pl%drift(system, param, dt)
call pl%getacch(system, param, t + dt)
call pl%kickvb(dth)
call pl%lindrift(cb, dth, ptend)
call pl%vb2vh(cb)
end associate

return

end subroutine helio_step_pl

module subroutine helio_step_tp(self, system, param, t, dt)

!! author: David A. Minton
!!
!! Step active test particles ahead using Democratic Heliocentric method
Expand All @@ -96,22 +97,24 @@ module subroutine helio_step_tp(self, system, param, t, dt)
logical, save :: lfirst = .true. !! Flag to indicate that this is the first call
real(DP) :: dth !! Half step size

! executable code
associate(cb => system%cb, pl => system%pl)
dth = 0.5_DP * dt
if (lfirst) then
call self%vh2vb(vbcb = -self%ptbeg)
lfirst = .false.
end if
call self%lindrift(dth, self%ptbeg)
call self%getacch(system, param, t, self%xbeg)
call self%kickvb(dth)
call self%drift(system, param, dt)
call self%getacch(system, param, t + dt, self%xend)
call self%kickvb(dth)
call self%lindrift(dth, self%ptend)
call self%vb2vh(vbcb = -self%ptend)
end associate
select type(system)
class is (helio_nbody_system)
associate(tp => self, cb => system%cb, pl => system%pl, xbeg => system%xbeg, xend => system%xend)
dth = 0.5_DP * dt
if (lfirst) then
call tp%vh2vb(vbcb = -tp%ptbeg)
lfirst = .false.
end if
call tp%lindrift(dth, tp%ptbeg)
call tp%getacch(system, param, t, xbeg)
call tp%kickvb(dth)
call tp%drift(system, param, dt)
call tp%getacch(system, param, t + dt, xend)
call tp%kickvb(dth)
call tp%lindrift(dth, tp%ptend)
call tp%vb2vh(vbcb = -tp%ptend)
end associate
end select

return

Expand Down
8 changes: 4 additions & 4 deletions src/io/io.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -517,13 +517,13 @@ end subroutine io_dump_system
module function io_get_args(integrator, param_file_name) result(ierr)
!! author: David A. Minton
!!
!! Reads in the name of the parameters file.
!! Reads in the name of the parameter file from command line arguments.
implicit none
! Arguments
integer(I4B) :: integrator !! Symbolic code of the requested integrator
character(len=:), allocatable :: param_file_name !! Name of the input parameters file
! Result
integer(I4B) :: ierr !! I/O error cod
integer(I4B) :: ierr !! I/O error code
! Internals
character(len=STRMAX) :: arg1, arg2
integer :: narg,ierr_arg1, ierr_arg2
Expand Down Expand Up @@ -574,7 +574,7 @@ module function io_get_args(integrator, param_file_name) result(ierr)
if (ierr /= 0) call util_exit(USAGE)
end function io_get_args

module function io_get_token(buffer, ifirst, ilast, ierr) result(token)
function io_get_token(buffer, ifirst, ilast, ierr) result(token)
!! author: David A. Minton
!!
!! Retrieves a character token from an input string. Here a token is defined as any set of contiguous non-blank characters not
Expand Down Expand Up @@ -1126,7 +1126,7 @@ module subroutine io_write_discard(self, param, discards)

end subroutine io_write_discard

subroutine io_write_encounter(t, name1, name2, mass1, mass2, radius1, radius2, &
module subroutine io_write_encounter(t, name1, name2, mass1, mass2, radius1, radius2, &
xh1, xh2, vh1, vh2, encounter_file, out_type)
!! author: David A. Minton
!!
Expand Down
0 src/driftkick/kick.f90 → src/kick/kick.f90
View file
File renamed without changes.
Loading

0 comments on commit f8c3dec

Please sign in to comment.