From 79a6e836fa6a46c7a919e050cb7299da51b42d65 Mon Sep 17 00:00:00 2001 From: David A Minton Date: Tue, 25 Oct 2022 16:43:24 -0400 Subject: [PATCH] Finished removing cruft (unused variables) --- src/discard/discard.f90 | 3 +-- src/drift/drift.f90 | 4 +-- src/encounter/encounter_check.f90 | 29 +++++---------------- src/fraggle/fraggle_generate.f90 | 6 ++--- src/fraggle/fraggle_regime.f90 | 5 ++-- src/fraggle/fraggle_set.f90 | 5 ++-- src/fraggle/fraggle_util.f90 | 6 ----- src/io/io.f90 | 18 +++---------- src/modules/fraggle_classes.f90 | 3 +-- src/netcdf/netcdf.f90 | 12 ++++----- src/obl/obl.f90 | 8 +++--- src/orbel/orbel.f90 | 1 - src/setup/setup.f90 | 2 -- src/symba/symba_collision.f90 | 2 +- src/symba/symba_discard.f90 | 2 +- src/symba/symba_kick.f90 | 3 +-- src/symba/symba_setup.f90 | 4 --- src/symba/symba_util.f90 | 7 ++--- src/tides/tides_spin_step.f90 | 37 +++++++++++++-------------- src/util/util_fill.f90 | 4 --- src/util/util_get_energy_momentum.f90 | 8 +++--- src/util/util_minimize_bfgs.f90 | 2 +- src/util/util_solve.f90 | 2 +- src/util/util_sort.f90 | 2 -- src/walltime/walltime.f90 | 6 +---- 25 files changed, 60 insertions(+), 121 deletions(-) diff --git a/src/discard/discard.f90 b/src/discard/discard.f90 index 558b8b899..23ef3541d 100644 --- a/src/discard/discard.f90 +++ b/src/discard/discard.f90 @@ -12,7 +12,7 @@ module subroutine discard_system(self, param) class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - logical :: lany_discards, lpl_discards, ltp_discards, lpl_check, ltp_check + logical :: lpl_discards, ltp_discards, lpl_check, ltp_check lpl_check = allocated(self%pl_discards) ltp_check = allocated(self%tp_discards) @@ -180,7 +180,6 @@ subroutine discard_peri_tp(tp, system, param) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameterss ! Internals - logical, save :: lfirst = .true. integer(I4B) :: i, j, ih real(DP) :: r2 real(DP), dimension(NDIM) :: dx diff --git a/src/drift/drift.f90 b/src/drift/drift.f90 index 3acc88609..2a5f3e472 100644 --- a/src/drift/drift.f90 +++ b/src/drift/drift.f90 @@ -80,11 +80,11 @@ module subroutine drift_all(mu, x, v, n, param, dt, lmask, iflag) where(lmask(1:n)) dtp(1:n) = dt end if - !$omp simd + !!$omp simd ! SIMD does not yet work do i = 1, n if (lmask(i)) call drift_one(mu(i), x(1,i), x(2,i), x(3,i), v(1,i), v(2,i), v(3,i), dtp(i), iflag(i)) end do - !$omp end simd + !!$omp end simd deallocate(dtp) diff --git a/src/encounter/encounter_check.f90 b/src/encounter/encounter_check.f90 index e790abf5a..d59ab38ce 100644 --- a/src/encounter/encounter_check.f90 +++ b/src/encounter/encounter_check.f90 @@ -25,7 +25,6 @@ module subroutine encounter_check_all_plpl(param, npl, x, v, renc, dt, & logical, save :: lfirst = .true. logical, save :: skipit = .false. ! This will be used to ensure that the sort & sweep subroutine gets called at least once before timing it so that the extent array is nearly sorted when it is timed integer(I8B) :: nplpl = 0_I8B - integer(I8B) :: k if (param%ladaptive_encounters_plpl .and. (.not. skipit)) then nplpl = (npl * (npl - 1) / 2) @@ -91,8 +90,7 @@ module subroutine encounter_check_all_plplm(param, nplm, nplt, xplm, vplm, xplt, logical, save :: lfirst = .true. logical, save :: skipit = .false. integer(I8B) :: nplplm = 0_I8B - integer(I4B) :: npl, i - integer(I8B) :: k + integer(I4B) :: npl logical, dimension(:), allocatable :: plmplt_lvdotr !! Logical flag indicating the sign of v .dot. x in the plm-plt group integer(I4B), dimension(:), allocatable :: plmplt_index1 !! List of indices for body 1 in each encounter in the plm-plt group integer(I4B), dimension(:), allocatable :: plmplt_index2 !! List of indices for body 2 in each encounter in the plm-lt group @@ -254,10 +252,9 @@ subroutine encounter_check_all_sort_and_sweep_plpl(npl, x, v, renc, dt, nenc, in integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - integer(I4B) :: i, dim, n + integer(I4B) :: dim, n integer(I4B), save :: npl_last = 0 type(encounter_bounding_box), save :: boundingbox - logical, dimension(:), allocatable :: lencounter integer(I2B), dimension(npl) :: vshift_min, vshift_max if (npl == 0) return @@ -316,12 +313,10 @@ subroutine encounter_check_all_sort_and_sweep_plplm(nplm, nplt, xplm, vplm, xplt logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals type(encounter_bounding_box), save :: boundingbox - integer(I4B) :: i, dim, n, ntot + integer(I4B) :: dim, n, ntot integer(I4B), save :: ntot_last = 0 - logical, dimension(:), allocatable :: lencounter integer(I2B), dimension(nplm) :: vplmshift_min, vplmshift_max integer(I2B), dimension(nplt) :: vpltshift_min, vpltshift_max - logical, save :: lfirst=.true. ! If this is the first time through, build the index lists if ((nplm == 0) .or. (nplt == 0)) return @@ -390,9 +385,8 @@ subroutine encounter_check_all_sort_and_sweep_pltp(npl, ntp, xpl, vpl, xtp, vtp, logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals type(encounter_bounding_box), save :: boundingbox - integer(I4B) :: i, dim, n, ntot + integer(I4B) :: dim, n, ntot integer(I4B), save :: ntot_last = 0 - logical, dimension(:), allocatable :: lencounter integer(I2B), dimension(npl) :: vplshift_min, vplshift_max integer(I2B), dimension(ntp) :: vtpshift_min, vtpshift_max real(DP), dimension(ntp) :: renctp @@ -467,7 +461,6 @@ pure subroutine encounter_check_all_sweep_one(i, n, xi, yi, zi, vxi, vyi, vzi, x logical, dimension(:), allocatable, intent(inout) :: lvdotr !! v.dot.r direction array ! Internals integer(I4B) :: j - integer(I8B) :: k real(DP) :: xr, yr, zr, vxr, vyr, vzr, renc12 logical, dimension(n) :: lencounteri, lvdotri @@ -515,7 +508,7 @@ pure subroutine encounter_check_all_triangular_one(i, n, xi, yi, zi, vxi, vyi, v type(encounter_list), intent(out) :: lenci !! Output encounter lists containing number of encounters, the v.dot.r direction array, and the index list of encountering bodies ! Internals integer(I4B) :: j - integer(I8B) :: k, nenci + integer(I8B) :: nenci real(DP) :: xr, yr, zr, vxr, vyr, vzr, renc12 logical, dimension(n) :: lencounteri, lvdotri @@ -559,9 +552,7 @@ subroutine encounter_check_all_triangular_plpl(npl, x, v, renc, dt, nenc, index1 integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals - integer(I4B) :: i, j, k, nenci, j0, j1 - real(DP) :: xr, yr, zr, vxr, vyr, vzr, renc12 - logical, dimension(npl) :: lencounteri, lvdotri + integer(I4B) :: i integer(I4B), dimension(:), allocatable, save :: ind_arr type(encounter_list), dimension(npl) :: lenc @@ -609,7 +600,6 @@ subroutine encounter_check_all_triangular_plplm(nplm, nplt, xplm, vplm, xplt, vp logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals integer(I4B) :: i - logical, dimension(nplt) :: lencounteri, lvdotri integer(I4B), dimension(:), allocatable, save :: ind_arr type(encounter_list), dimension(nplm) :: lenc @@ -656,7 +646,6 @@ subroutine encounter_check_all_triangular_pltp(npl, ntp, xpl, vpl, xtp, vtp, ren logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical flag indicating the sign of v .dot. x ! Internals integer(I4B) :: i - logical, dimension(ntp) :: lencounteri, lvdotri integer(I4B), dimension(:), allocatable, save :: ind_arr type(encounter_list), dimension(npl) :: lenc real(DP), dimension(ntp) :: renct @@ -914,15 +903,11 @@ module subroutine encounter_check_sweep_aabb_double_list(self, n1, n2, x1, v1, x integer(I4B), dimension(:), allocatable, intent(out) :: index2 !! List of indices for body 2 in each encounter candidate pair logical, dimension(:), allocatable, intent(out) :: lvdotr !! Logical array indicating which pairs are approaching ! Internals - integer(I4B) :: ii, i, j, ntot, nbox, dim - integer(I8B) :: k + integer(I4B) :: ii, i, ntot, nbox, dim logical, dimension(n1+n2) :: loverlap logical, dimension(SWEEPDIM,n1+n2) :: loverlap_by_dimension - integer(I4B), dimension(SWEEPDIM) :: noverlap - integer(I4B), dimension(SWEEPDIM,n1+n2) :: nbox_arr logical, dimension(SWEEPDIM,2*(n1+n2)) :: llist1 integer(I4B), dimension(SWEEPDIM,2*(n1+n2)) :: ext_ind - integer(I4B), dimension(:), allocatable :: x_ind type(encounter_list), dimension(n1+n2) :: lenc !! Array of encounter lists (one encounter list per body) integer(I4B), dimension(:), allocatable, save :: ind_arr integer(I8B) :: ibeg, iend diff --git a/src/fraggle/fraggle_generate.f90 b/src/fraggle/fraggle_generate.f90 index e899f0b64..21f6d386a 100644 --- a/src/fraggle/fraggle_generate.f90 +++ b/src/fraggle/fraggle_generate.f90 @@ -83,7 +83,7 @@ module subroutine fraggle_generate_fragments(self, colliders, system, param, lfa end do call frag%get_energy_and_momentum(colliders, system, param, lbefore=.false.) - call frag%set_budgets(colliders) + call frag%set_budgets() call fraggle_generate_spins(frag, f_spin, lfailure) if (lfailure) then @@ -300,10 +300,9 @@ subroutine fraggle_generate_tan_vel(frag, lfailure) real(DP), parameter :: TOL_INIT = 1e-14_DP real(DP), parameter :: VNOISE_MAG = 1e-3_DP !! Magnitude of the noise to apply to initial conditions to help minimizer find a solution in case of failure integer(I4B), parameter :: MAXLOOP = 10 - real(DP) :: tol, ke_remainder + real(DP) :: tol real(DP), dimension(:), allocatable :: v_t_initial real(DP), dimension(frag%nbody) :: kefrag, vnoise - type(lambda_obj) :: spinfunc type(lambda_obj_err) :: objective_function real(DP), dimension(NDIM) :: Li, L_remainder, L_frag_tot character(len=STRMAX) :: message @@ -479,7 +478,6 @@ subroutine fraggle_generate_rad_vel(frag, lfailure) real(DP) :: ke_radial, tol integer(I4B) :: i real(DP), dimension(:), allocatable :: v_r_initial - real(DP), dimension(:,:), allocatable :: v_r real(DP), dimension(frag%nbody) :: vnoise type(lambda_obj) :: objective_function character(len=STRMAX) :: message diff --git a/src/fraggle/fraggle_regime.f90 b/src/fraggle/fraggle_regime.f90 index abe5766f0..ef217efe8 100644 --- a/src/fraggle/fraggle_regime.f90 +++ b/src/fraggle/fraggle_regime.f90 @@ -15,12 +15,11 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) class(swiftest_nbody_system), intent(in) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters ! Internals - integer(I4B) :: jtarg, jproj, regime + integer(I4B) :: jtarg, jproj real(DP), dimension(2) :: radius_si, mass_si, density_si real(DP) :: min_mfrag_si, Mcb_si real(DP), dimension(NDIM) :: x1_si, v1_si, x2_si, v2_si - real(DP) :: mlr, mslr, mtot, dentot, msys, msys_new, Qloss, impact_parameter - logical :: fileExists + real(DP) :: mlr, mslr, mtot, dentot associate(colliders => self) ! Convert all quantities to SI units and determine which of the pair is the projectile vs. target before sending them to the regime determination subroutine diff --git a/src/fraggle/fraggle_set.f90 b/src/fraggle/fraggle_set.f90 index baf29f8b0..ee8a50e98 100644 --- a/src/fraggle/fraggle_set.f90 +++ b/src/fraggle/fraggle_set.f90 @@ -2,14 +2,13 @@ use swiftest contains - module subroutine fraggle_set_budgets_fragments(self, colliders) + module subroutine fraggle_set_budgets_fragments(self) !! author: David A. Minton !! !! Sets the energy and momentum budgets of the fragments based on the collider values and the before/after values of energy and momentum implicit none ! Arguments class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object ! Internals real(DP) :: dEtot real(DP), dimension(NDIM) :: dL @@ -162,7 +161,7 @@ module subroutine fraggle_set_coordinate_system(self, colliders) class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object ! Internals integer(I4B) :: i - real(DP), dimension(NDIM) :: x_cross_v, delta_r, delta_v, Ltot + real(DP), dimension(NDIM) :: delta_r, delta_v, Ltot real(DP) :: r_col_norm, v_col_norm, L_mag real(DP), dimension(NDIM, self%nbody) :: L_sigma diff --git a/src/fraggle/fraggle_util.f90 b/src/fraggle/fraggle_util.f90 index f2c082242..748831664 100644 --- a/src/fraggle/fraggle_util.f90 +++ b/src/fraggle/fraggle_util.f90 @@ -138,10 +138,7 @@ module subroutine fraggle_util_get_energy_momentum(self, colliders, system, para class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameters logical, intent(in) :: lbefore !! Flag indicating that this the "before" state of the system, with colliders included and fragments excluded or vice versa ! Internals - integer(I4B) :: i, nplm logical, dimension(:), allocatable :: lexclude - logical :: lk_plpl - logical, save :: ladd_frags class(swiftest_nbody_system), allocatable, save :: tmpsys class(swiftest_parameters), allocatable, save :: tmpparam integer(I4B) :: npl_before, npl_after @@ -214,10 +211,7 @@ module subroutine fraggle_util_restructure(self, colliders, try, f_spin, r_max_s real(DP), intent(inout) :: f_spin !! Fraction of energy/momentum that goes into spin. This decreases ater a failed attempt real(DP), intent(inout) :: r_max_start !! The maximum radial distance that the position calculation starts with. This increases after a failed attempt ! Internals - integer(I4B) :: i real(DP), save :: ke_tot_deficit, r_max_start_old, ke_avg_deficit_old - real(DP), dimension(:), allocatable :: m_frag_new, rad_frag_new - real(DP), dimension(:,:), allocatable :: xb_frag_new, vb_frag_new, Ip_frag_new, rot_frag_new real(DP) :: delta_r, delta_r_max, ke_avg_deficit real(DP), parameter :: ke_avg_deficit_target = 0.0_DP diff --git a/src/io/io.f90 b/src/io/io.f90 index 27068aeb9..b3f09bfd5 100644 --- a/src/io/io.f90 +++ b/src/io/io.f90 @@ -234,7 +234,6 @@ module subroutine io_dump_base(self, param) class(swiftest_base), intent(inout) :: self !! Swiftest base object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: ierr !! Error code integer(I4B) :: iu = LUN character(len=:), allocatable :: dump_file_name character(STRMAX) :: errmsg @@ -951,13 +950,6 @@ module subroutine io_param_writer(self, unit, iotype, v_list, iostat, iomsg) character(*),parameter :: Ifmt = '(I0)' !! Format label for integer values character(*),parameter :: Rfmt = '(ES25.17)' !! Format label for real values character(*),parameter :: Lfmt = '(L1)' !! Format label for logical values - character(len=NAMELEN) :: param_name - character(LEN=STRMAX) :: param_value, v1, v2, v3 - type character_array - character(25) :: value - end type character_array - type(character_array), dimension(:), allocatable :: param_array - integer(I4B) :: i associate(param => self) call io_param_writer_one("T0", param%t0, unit) @@ -1244,8 +1236,6 @@ module subroutine io_read_in_base(self,param) implicit none class(swiftest_base), intent(inout) :: self !! Swiftest base object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: ierr !! Error code: returns 0 if the read is successful if ((param%in_type == NETCDF_FLOAT_TYPE) .or. (param%in_type == NETCDF_DOUBLE_TYPE)) return ! This method is not used in NetCDF mode, as reading is done for the whole system, not on individual particle types @@ -1276,9 +1266,9 @@ subroutine io_read_in_body(self, param) integer(I4B) :: i, nbody logical :: is_ascii character(len=:), allocatable :: infile - real(DP) :: t character(STRMAX) :: errmsg - integer(I4B) :: ierr + ! Internals + integer(I4B) :: ierr !! Error code: returns 0 if the read is successful ! Select the appropriate polymorphic class (test particle or massive body) @@ -1337,7 +1327,7 @@ subroutine io_read_in_cb(self, param) ! Internals integer(I4B) :: iu = LUN character(len=STRMAX) :: errmsg - integer(I4B) :: ierr, idold + integer(I4B) :: ierr character(len=NAMELEN) :: name if (param%in_type == 'ASCII') then @@ -1843,7 +1833,7 @@ module subroutine io_read_particle_info_system(self, param) class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, id, idx + integer(I4B) :: id, idx logical :: lmatch character(STRMAX) :: errmsg type(swiftest_particle_info), allocatable :: tmpinfo diff --git a/src/modules/fraggle_classes.f90 b/src/modules/fraggle_classes.f90 index 042ff5a78..4621a9e34 100644 --- a/src/modules/fraggle_classes.f90 +++ b/src/modules/fraggle_classes.f90 @@ -164,10 +164,9 @@ module subroutine fraggle_regime_colliders(self, frag, system, param) class(swiftest_parameters), intent(in) :: param !! Current Swiftest run configuration parameters end subroutine fraggle_regime_colliders - module subroutine fraggle_set_budgets_fragments(self, colliders) + module subroutine fraggle_set_budgets_fragments(self) implicit none class(fraggle_fragments), intent(inout) :: self !! Fraggle fragment system object - class(fraggle_colliders), intent(inout) :: colliders !! Fraggle collider system object end subroutine fraggle_set_budgets_fragments module subroutine fraggle_set_coordinate_system(self, colliders) diff --git a/src/netcdf/netcdf.f90 b/src/netcdf/netcdf.f90 index e0118dfc7..4a39b5e1b 100644 --- a/src/netcdf/netcdf.f90 +++ b/src/netcdf/netcdf.f90 @@ -69,7 +69,7 @@ module function netcdf_get_old_t_final_system(self, param) result(old_t_final) real(DP), dimension(:), allocatable :: vals real(DP), dimension(1) :: val real(DP), dimension(NDIM) :: rot0, Ip0, Lnow - real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig, Ltmp + real(DP) :: KE_orb_orig, KE_spin_orig, PE_orig call param%nciu%open(param) call check( nf90_inquire_dimension(param%nciu%ncid, param%nciu%time_dimid, len=itmax), "netcdf_get_old_t_final_system time_dimid" ) @@ -168,12 +168,12 @@ module subroutine netcdf_initialize_output(self, param) class(netcdf_parameters), intent(inout) :: self !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: old_mode, nvar, varid, vartype, old_unit + integer(I4B) :: nvar, varid, vartype real(DP) :: dfill real(SP) :: sfill logical :: fileExists character(len=STRMAX) :: errmsg - integer(I4B) :: storage, ndims, i + integer(I4B) :: ndims dfill = ieee_value(dfill, IEEE_QUIET_NAN) sfill = ieee_value(sfill, IEEE_QUIET_NAN) @@ -478,7 +478,7 @@ module function netcdf_read_frame_system(self, iu, param) result(ierr) ! Return integer(I4B) :: ierr !! Error code: returns 0 if the read is successful ! Internals - integer(I4B) :: dim, i, j, tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max + integer(I4B) :: tslot, idmax, npl_check, ntp_check, nplm_check, t_max, str_max real(DP), dimension(:), allocatable :: rtemp integer(I4B), dimension(:), allocatable :: itemp logical, dimension(:), allocatable :: validmask, tpmask, plmask @@ -774,7 +774,7 @@ module subroutine netcdf_read_particle_info_system(self, iu, param, plmask, tpma logical, dimension(:), intent(in) :: plmask !! Logical array indicating which index values belong to massive bodies logical, dimension(:), intent(in) :: tpmask !! Logical array indicating which index values belong to test particles ! Internals - integer(I4B) :: i, j, tslot, idslot, old_mode, idmax + integer(I4B) :: i, idmax real(DP), dimension(:), allocatable :: rtemp real(DP), dimension(:,:), allocatable :: rtemp_arr integer(I4B), dimension(:), allocatable :: itemp @@ -1091,7 +1091,7 @@ module subroutine netcdf_write_particle_info_base(self, iu, param) class(netcdf_parameters), intent(inout) :: iu !! Parameters used to identify a particular NetCDF dataset class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j, tslot, idslot, old_mode + integer(I4B) :: i, j, idslot, old_mode integer(I4B), dimension(:), allocatable :: ind character(len=NAMELEN) :: charstring diff --git a/src/obl/obl.f90 b/src/obl/obl.f90 index bf369c615..88b66cf90 100644 --- a/src/obl/obl.f90 +++ b/src/obl/obl.f90 @@ -128,7 +128,7 @@ module subroutine obl_pot_system(self) associate(system => self, pl => self%pl, npl => self%pl%nbody, cb => self%cb) if (.not. any(pl%lmask(1:npl))) return do concurrent (i = 1:npl, pl%lmask(i)) - oblpot_arr(i) = obl_pot_one(npl, cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%xh(3,i), 1.0_DP / norm2(pl%xh(:,i))) + oblpot_arr(i) = obl_pot_one(cb%Gmass, pl%Gmass(i), cb%j2rp2, cb%j4rp4, pl%xh(3,i), 1.0_DP / norm2(pl%xh(:,i))) end do system%oblpot = sum(oblpot_arr, pl%lmask(1:npl)) end associate @@ -137,7 +137,7 @@ module subroutine obl_pot_system(self) end subroutine obl_pot_system - elemental function obl_pot_one(npl, GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) + elemental function obl_pot_one(GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(oblpot) !! author: David A. Minton !! !! Compute the contribution to the total gravitational potential due solely to the oblateness of the central body from a single massive body @@ -149,7 +149,6 @@ elemental function obl_pot_one(npl, GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(ob !! Adapted from Hal Levison's Swift routine obl_pot.f implicit none ! Arguments - integer(I4B), intent(in) :: npl !! Number of massive bodies real(DP), intent(in) :: GMcb !! G*mass of the central body real(DP), intent(in) :: GMpl !! G*mass of the massive body real(DP), intent(in) :: j2rp2 !! J_2 / R**2 of the central body @@ -160,8 +159,7 @@ elemental function obl_pot_one(npl, GMcb, GMpl, j2rp2, j4rp4, zh, irh) result(ob real(DP) :: oblpot !! Gravitational potential ! Internals - integer(I4B) :: i - real(DP) :: rinv2, t0, t1, t2, t3, p2, p4, mu + real(DP) :: rinv2, t0, t1, t2, t3, p2, p4 rinv2 = irh**2 t0 = GMcb * GMpl * rinv2 * irh diff --git a/src/orbel/orbel.f90 b/src/orbel/orbel.f90 index 31f7f23c3..c7f3a63c2 100644 --- a/src/orbel/orbel.f90 +++ b/src/orbel/orbel.f90 @@ -217,7 +217,6 @@ real(DP) pure function orbel_flon(e,icapn) real(DP) :: a,b,sq,biga,bigb, capn real(DP) :: x,x2 real(DP) :: f,fp,dx - real(DP) :: diff real(DP) :: a0,a1 real(DP) :: b1 integer(I4B), parameter :: IMAX = 10 diff --git a/src/setup/setup.f90 b/src/setup/setup.f90 index 9a7fe7e78..eb9281558 100644 --- a/src/setup/setup.f90 +++ b/src/setup/setup.f90 @@ -80,7 +80,6 @@ module subroutine setup_finalize_system(self, param) ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr associate(system => self) if ((param%out_type == NETCDF_FLOAT_TYPE) .or. (param%out_type == NETCDF_DOUBLE_TYPE)) then @@ -132,7 +131,6 @@ module subroutine setup_initialize_system(self, param) ! Arguments class(swiftest_nbody_system), intent(inout) :: self !! Swiftest system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - integer(I4B) :: ierr associate(system => self, cb => self%cb, pl => self%pl, tp => self%tp) diff --git a/src/symba/symba_collision.f90 b/src/symba/symba_collision.f90 index f7a54f24a..96be938ca 100644 --- a/src/symba/symba_collision.f90 +++ b/src/symba/symba_collision.f90 @@ -448,7 +448,7 @@ function symba_collision_consolidate_colliders(pl, cb, param, idx_parent, collid integer(I4B), dimension(2) :: nchild integer(I4B) :: i, j, ncolliders, idx_child real(DP), dimension(2) :: volume, density - real(DP) :: mchild, mtot, volchild + real(DP) :: mchild, volchild real(DP), dimension(NDIM) :: xc, vc, xcom, vcom, xchild, vchild, xcrossv real(DP), dimension(NDIM,2) :: mxc, vcc diff --git a/src/symba/symba_discard.f90 b/src/symba/symba_discard.f90 index 385f6f25b..5dd70afcc 100644 --- a/src/symba/symba_discard.f90 +++ b/src/symba/symba_discard.f90 @@ -18,7 +18,7 @@ subroutine symba_discard_cb_pl(pl, system, param) class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j + integer(I4B) :: i real(DP) :: energy, vb2, rb2, rh2, rmin2, rmax2, rmaxu2 character(len=STRMAX) :: idstr, timestr, message diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index d908c071e..f6db7902a 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -61,7 +61,6 @@ module subroutine symba_kick_getacch_pl(self, system, param, t, lbeg) real(DP), intent(in) :: t !! Current simulation time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals - integer(I4B) :: i integer(I8B) :: nplplenc real(DP), dimension(NDIM,self%nbody) :: ah_enc integer(I4B), dimension(:,:), allocatable :: k_plpl_enc @@ -106,7 +105,7 @@ module subroutine symba_kick_getacch_tp(self, system, param, t, lbeg) logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the step ! Internals integer(I4B) :: i, j, k - real(DP) :: rjj, fac, rlim2 + real(DP) :: rjj, fac real(DP), dimension(NDIM) :: dx if (self%nbody == 0) return diff --git a/src/symba/symba_setup.f90 b/src/symba/symba_setup.f90 index d48cc7511..f842d35b2 100644 --- a/src/symba/symba_setup.f90 +++ b/src/symba/symba_setup.f90 @@ -12,8 +12,6 @@ module subroutine symba_setup_initialize_system(self, param) ! Arguments class(symba_nbody_system), intent(inout) :: self !! SyMBA system object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters - ! Internals - integer(I4B) :: i, j ! Call parent method associate(system => self) @@ -38,8 +36,6 @@ module subroutine symba_setup_merger(self, n, param) class(symba_merger), intent(inout) :: self !! SyMBA merger list object integer(I4B), intent(in) :: n !! Number of particles to allocate space for class(swiftest_parameters), intent(in) :: param !! Current run configuration parameter - ! Internals - integer(I4B) :: i !> Call allocation method for parent class. In this case, helio_pl does not have its own setup method so we use the base method for swiftest_pl call symba_setup_pl(self, n, param) diff --git a/src/symba/symba_util.f90 b/src/symba/symba_util.f90 index 0cbdc9a4a..c927afb7c 100644 --- a/src/symba/symba_util.f90 +++ b/src/symba/symba_util.f90 @@ -402,8 +402,7 @@ module subroutine symba_util_flatten_eucl_plpl(self, param) class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals - integer(I8B) :: k, npl, nplm - integer(I4B) :: i, j, err + integer(I8B) :: npl, nplm associate(pl => self, nplplm => self%nplplm) npl = int(self%nbody, kind=I8B) @@ -600,7 +599,7 @@ module subroutine symba_util_rearray_pl(self, system, param) class(symba_parameters), intent(inout) :: param !! Current run configuration parameters ! Internals class(symba_pl), allocatable :: tmp !! The discarded body list. - integer(I4B) :: i, j, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 + integer(I4B) :: i, k, npl, nadd, nencmin, nenc_old, idnew1, idnew2, idold1, idold2 logical, dimension(:), allocatable :: lmask, ldump_mask class(symba_plplenc), allocatable :: plplenc_old logical :: lencounter @@ -1044,8 +1043,6 @@ module subroutine symba_util_sort_rearrange_pl(self, ind) ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body object integer(I4B), dimension(:), intent(in) :: ind !! Index array used to restructure the body (should contain all 1:n index values in the desired order) - ! Internals - integer(I4B) :: i, j associate(pl => self, npl => self%nbody) call util_sort_rearrange(pl%lcollision, ind, npl) diff --git a/src/tides/tides_spin_step.f90 b/src/tides/tides_spin_step.f90 index 576aff8d7..257fa68e3 100644 --- a/src/tides/tides_spin_step.f90 +++ b/src/tides/tides_spin_step.f90 @@ -41,16 +41,16 @@ module subroutine tides_step_spin_system(self, param, t, dt) real(DP), intent(in) :: t !! Simulation time real(DP), intent(in) :: dt !! Current stepsize ! Internals - real(DP), dimension(:), allocatable :: rot0, rot1 - real(DP) :: subt - real(DP), parameter :: tol=1e-6_DP !! Just a guess at the moment - real(DP) :: subdt + !real(DP), dimension(:), allocatable :: rot0 !, rot1 + !real(DP) :: subt + !real(DP), parameter :: tol=1e-6_DP !! Just a guess at the moment + !real(DP) :: subdt associate(pl => self%pl, npl => self%pl%nbody, cb => self%cb) - allocate(rot0(NDIM*(npl+1))) - rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] + !allocate(rot0(NDIM*(npl+1))) + !rot0 = [pack(pl%rot(:,1:npl),.true.), pack(cb%rot(:),.true.)] ! Use this space call the ode_solver, passing tides_spin_derivs as the function: - subdt = dt / 20._DP + !subdt = dt / 20._DP !rot1(:) = util_solve_rkf45(lambda_obj(tides_spin_derivs, subdt, pl%xbeg, pl%xend), rot0, dt, subdt tol) ! Recover with unpack !pl%rot(:,1:npl) = unpack(rot1... @@ -74,23 +74,22 @@ function tides_spin_derivs(rot_pl_cb, t, dt, xbeg, xend) result(drot) !! Need to real(DP), dimension(:,:), intent(in) :: xend ! Internals real(DP), dimension(:,:), allocatable :: drot - real(DP), dimension(:), allocatable :: flatrot - real(DP), dimension(NDIM) :: N_Tcb, N_Rcb, N_Tpl, N_Rpl, xinterp - real(DP) :: C_cb, C_pl, r_dot_rot_cb, r_dot_rot_pl, rmag - integer(I4B) :: i, n + ! !real(DP), dimension(NDIM) :: N_Tcb, N_Rcb, N_Tpl, N_Rpl, xinterp + ! !real(DP) :: C_cb, C_pl, r_dot_rot_cb, r_dot_rot_pl, rmag + ! integer(I4B) :: i, n - n = size(rot_pl_cb,2) if (allocated(drot)) deallocate(drot) allocate(drot, mold=rot_pl_cb) drot(:,:) = 0.0_DP - do i = 1,n-1 - xinterp(:) = xbeg(:,i) + t / dt * (xend(:,i) - xbeg(:,i)) - ! Calculate Ncb and Npl as a function of xinterp - !drot(:,i) = -Mcb / (Mcb + Mpl(i)) * (N_Tpl + N_Rpl) - !drot(:,n) = drot(:,n) - Mcb / (Mcb + Mpl(i) * (N_Tcb + N_Rcb) - ! - end do + ! n = size(rot_pl_cb,2) + ! do i = 1,n-1 + ! xinterp(:) = xbeg(:,i) + t / dt * (xend(:,i) - xbeg(:,i)) + ! ! Calculate Ncb and Npl as a function of xinterp + ! !drot(:,i) = -Mcb / (Mcb + Mpl(i)) * (N_Tpl + N_Rpl) + ! !drot(:,n) = drot(:,n) - Mcb / (Mcb + Mpl(i) * (N_Tcb + N_Rcb) + ! ! + ! end do return end function tides_spin_derivs diff --git a/src/util/util_fill.f90 b/src/util/util_fill.f90 index bd0014be4..c11a0f55d 100644 --- a/src/util/util_fill.f90 +++ b/src/util/util_fill.f90 @@ -141,8 +141,6 @@ module subroutine util_fill_body(self, inserts, lfill_list) class(swiftest_body), intent(inout) :: self !! Swiftest generic body object class(swiftest_body), intent(in) :: inserts !! Inserted object logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - ! internals - integer(I4B) :: i ! For each component, pack the discarded bodies into the discard object and do the inverse with the keeps !> Fill all the common components @@ -186,8 +184,6 @@ module subroutine util_fill_pl(self, inserts, lfill_list) class(swiftest_pl), intent(inout) :: self !! Swiftest massive body object class(swiftest_body), intent(in) :: inserts !! Swiftest body object to be inserted logical, dimension(:), intent(in) :: lfill_list !! Logical array of bodies to merge into the keeps - ! Internals - integer(I4B) :: i associate(keeps => self) diff --git a/src/util/util_get_energy_momentum.f90 b/src/util/util_get_energy_momentum.f90 index 65e9b90d0..80fcb5c7a 100644 --- a/src/util/util_get_energy_momentum.f90 +++ b/src/util/util_get_energy_momentum.f90 @@ -13,10 +13,10 @@ module subroutine util_get_energy_momentum_system(self, param) class(swiftest_nbody_system), intent(inout) :: self !! Swiftest nbody system object class(swiftest_parameters), intent(in) :: param !! Current run configuration parameters ! Internals - integer(I4B) :: i, j - integer(I8B) :: k, nplpl - real(DP) :: oblpot, kecb, kespincb - real(DP), dimension(self%pl%nbody) :: irh, kepl, kespinpl + integer(I4B) :: i + integer(I8B) :: nplpl + real(DP) :: kecb, kespincb + real(DP), dimension(self%pl%nbody) :: kepl, kespinpl real(DP), dimension(self%pl%nbody) :: Lplorbitx, Lplorbity, Lplorbitz real(DP), dimension(self%pl%nbody) :: Lplspinx, Lplspiny, Lplspinz real(DP), dimension(NDIM) :: Lcborbit, Lcbspin diff --git a/src/util/util_minimize_bfgs.f90 b/src/util/util_minimize_bfgs.f90 index cac951a99..3dd26f9dd 100644 --- a/src/util/util_minimize_bfgs.f90 +++ b/src/util/util_minimize_bfgs.f90 @@ -29,7 +29,7 @@ module function util_minimize_bfgs(f, N, x0, eps, maxloop, lerr) result(x1) ! Result real(DP), dimension(:), allocatable :: x1 ! Internals - integer(I4B) :: i, j, k, l, conv, num + integer(I4B) :: i, j, k, l, conv real(DP), parameter :: graddelta = 1e-4_DP !! Delta x for gradient calculations real(DP), dimension(N) :: S !! Direction vectors real(DP), dimension(N,N) :: H !! Approximated inverse Hessian matrix diff --git a/src/util/util_solve.f90 b/src/util/util_solve.f90 index 057ed1182..d93dbf39e 100644 --- a/src/util/util_solve.f90 +++ b/src/util/util_solve.f90 @@ -170,7 +170,7 @@ module function util_solve_rkf45(f, y0in, t1, dt0, tol) result(y1) integer(I4B) :: rkn !! Runge-Kutta loop index real(DP) :: t, x1, dt, trem !! Current time, step size and total time remaining real(DP) :: s, yerr, yscale !! Step size reduction factor, error in dependent variable, and error scale factor - integer(I4B) :: i, n + integer(I4B) :: i allocate(y0, source=y0in) allocate(y1, mold=y0) diff --git a/src/util/util_sort.f90 b/src/util/util_sort.f90 index ebc6223c4..db1bf4d60 100644 --- a/src/util/util_sort.f90 +++ b/src/util/util_sort.f90 @@ -931,8 +931,6 @@ module subroutine util_sort_rearrange_arr_info(arr, ind, n) integer(I4B), intent(in) :: n !! Number of elements in arr and ind to rearrange ! Internals type(swiftest_particle_info), dimension(:), allocatable :: tmp !! Temporary copy of array used during rearrange operation - integer(I4B) :: i - if (.not. allocated(arr) .or. n <= 0) return allocate(tmp, mold=arr) diff --git a/src/walltime/walltime.f90 b/src/walltime/walltime.f90 index ba9e8ab57..4e7f81a83 100644 --- a/src/walltime/walltime.f90 +++ b/src/walltime/walltime.f90 @@ -80,8 +80,6 @@ module subroutine walltime_reset(self) ! Arguments class(walltimer), intent(inout) :: self !! Walltimer object ! Internals - integer(I8B) :: count_delta - self%is_paused = .false. self%wall_step = 0.0_DP @@ -147,7 +145,7 @@ module subroutine walltime_interaction_adapt(self, param, ninteractions, pl) integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing class(swiftest_pl), intent(inout), optional :: pl !! Swiftest massive body object ! Internals - character(len=STRMAX) :: tstr, nstr, cstr, mstr + character(len=STRMAX) :: nstr, cstr, mstr character(len=11) :: lstyle, advancedstyle, standardstyle character(len=1) :: schar logical :: ladvanced_final @@ -233,8 +231,6 @@ module function walltime_interaction_check(self, param, ninteractions) result(lt class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters integer(I8B), intent(in) :: ninteractions !! Current number of interactions (used to normalize the timed loop and to determine if number of interactions has changed since the last timing logical :: ltimeit !! Logical flag indicating whether this loop should be timed or not - ! Internals - character(len=STRMAX) :: tstring if (self%is_on) then ! Entering the second stage of the loop timing. Therefore we will swap the interaction style and time this loop self%stage = self%stage + 1