Major restructuring of RMVS class. Moved encounter objects into container to help streamline data management. Made numerous other changes to clean up the code.

MintonGroup · Apr 16, 2021 · 8cfa099 · 8cfa099
1 parent 6219c3e
commit 8cfa099
Show file tree

Hide file tree

Showing 25 changed files with 745 additions and 853 deletions.
diff --git a/Makefile b/Makefile
@@ -58,14 +58,12 @@ SWIFTEST_MODULES =   swiftest_globals.f90 \
 include Makefile.Defines
 
 MODULES         = $(SWIFTEST_MODULES) $(USER_MODULES)
-IADVIXE          = ${ADVISOR_2019_DIR}/include/intel64
-LADVIXE          = ${ADVISOR_2019_DIR}/lib64
 
 .PHONY : all mod lib libdir drivers bin clean force 
 
 % : %.f90 force
-	$(FORTRAN) $(FFLAGS) -I$(SWIFTEST_HOME)/include -I$(IADVIXE) $< -o $@ \
-	  -L$(SWIFTEST_HOME)/lib -L$(LADVIXE) -lswiftest -ladvisor
+	$(FORTRAN) $(FFLAGS) -I$(SWIFTEST_HOME)/include $< -o $@ \
+	  -L$(SWIFTEST_HOME)/lib -lswiftest 
 	$(INSTALL_PROGRAM) $@ $(SWIFTEST_HOME)/bin
 	rm -f $@
 
@@ -77,7 +75,7 @@ all:
 
 mod:
 	cd $(SWIFTEST_HOME)/src/modules/; \
-	  $(FORTRAN) $(FFLAGS) -I$(SWIFTEST_HOME)/include -I$(IADVIXE) -c $(MODULES); \
+	  $(FORTRAN) $(FFLAGS) -I$(SWIFTEST_HOME)/include -c $(MODULES); \
 	  $(AR) rv $(SWIFTEST_HOME)/lib/libswiftest.a *.o; \
 	  $(INSTALL_DATA) *.mod *.smod $(SWIFTEST_HOME)/include; \
 	  rm -f *.o *.mod  *.smod
@@ -128,11 +126,6 @@ lib:
 	  ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
 	  ln -s $(SWIFTEST_HOME)/Makefile .; \
 	  make libdir
-	cd $(SWIFTEST_HOME)/src/step; \
-	  rm -f Makefile.Defines Makefile; \
-	  ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
-	  ln -s $(SWIFTEST_HOME)/Makefile .; \
-	  make libdir
 	cd $(SWIFTEST_HOME)/src/util; \
 	  rm -f Makefile.Defines Makefile; \
 	  ln -s $(SWIFTEST_HOME)/Makefile.Defines .; \
@@ -160,7 +153,7 @@ lib:
 	  make libdir
 
 libdir:
-	$(FORTRAN) $(FFLAGS) -I$(SWIFTEST_HOME)/include -I$(IADVIXE) -c *.f90; \
+	$(FORTRAN) $(FFLAGS) -I$(SWIFTEST_HOME)/include -c *.f90; \
 	$(AR) rv $(SWIFTEST_HOME)/lib/libswiftest.a *.o *.smod; \
 	$(INSTALL_DATA) *.smod $(SWIFTEST_HOME)/include; \
 	rm -f *.o *.smod
@@ -194,7 +187,6 @@ clean:
 	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/setup;   rm -f Makefile.Defines Makefile *.gc*
-	cd $(SWIFTEST_HOME)/src/step;    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*

diff --git a/Makefile.Defines b/Makefile.Defines
@@ -71,6 +71,8 @@ GPAR = -fopenmp -ftree-parallelize-loops=4
 GMEM = -fsanitize=undefined -fsanitize=address -fsanitize=leak 
 GWARNINGS = -Wall -Warray-bounds  -Wimplicit-interface -Wextra -Warray-temporaries
 
+FORTRAN = gfortran
+FFLAGS = $(GDEBUG)
 
 
 # DO NOT include in CFLAGS the "-c" option to compile object only

diff --git a/src/driftkick/drift.f90 b/src/driftkick/drift.f90
@@ -9,7 +9,8 @@
    integer(I2B), parameter :: NLAG2    = 40
 
 contains
-   module pure subroutine drift_one(mu, x, v, dt, iflag) 
+   module pure subroutine drift_one(mu, px, py, pz, vx, vy, vz, dt, iflag) 
+      !$omp declare simd
       !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott
       !!
       !! Perform Danby drift for one body, redoing drift with smaller substeps if original accuracy is insufficient
@@ -19,12 +20,16 @@ module pure subroutine drift_one(mu, x, v, dt, iflag)
       implicit none
       ! Arguments
       real(DP), intent(in)                   :: mu    !! G * (Mcb + m), G = gravitational constant, Mcb = mass of central body, m = mass of body to drift
-      real(DP), dimension(:), intent(inout)  :: x, v  !! Position and velocity of body to drift
+      real(DP), intent(inout)  :: px, py, pz, vx, vy, vz !! Position and velocity of body to drift
       real(DP), intent(in)                   :: dt    !! Step size
       integer(I4B), intent(out)              :: iflag !! iflag : error status flag for Danby drift (0 = OK, nonzero = ERROR)
       ! Internals
       integer(I4B) :: i
       real(DP)   :: dttmp
+      real(DP), dimension(NDIM) :: x, v
+
+      x = [px, py, pz]
+      v = [vx, vy, vz]
 
       call drift_dan(mu, x(:), v(:), dt, iflag)
       if (iflag /= 0) then
@@ -34,12 +39,14 @@ module pure subroutine drift_one(mu, x, v, dt, iflag)
             if (iflag /= 0) return
          end do
       end if
+      px = x(1); py = x(2); pz = x(3)
+      vx = v(1); vy = v(2); vz = v(3)
 
       return
    end subroutine drift_one
 
    pure subroutine drift_dan(mu, x0, v0, dt0, iflag)
-      !$omp declare simd(drift_dan)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Perform Kepler drift, solving Kepler's equation in appropriate variables
@@ -109,7 +116,7 @@ pure subroutine drift_dan(mu, x0, v0, dt0, iflag)
    end subroutine drift_dan
 
    pure subroutine drift_kepmd(dm, es, ec, x, s, c)
-      !$omp declare simd(drift_kepmd)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Solve Kepler's equation in difference form for an ellipse for small input dm and eccentricity
@@ -148,7 +155,7 @@ pure subroutine drift_kepmd(dm, es, ec, x, s, c)
    end subroutine drift_kepmd
 
    pure subroutine drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag)
-      !$omp declare simd(drift_kepu)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Solve Kepler's equation in universal variables
@@ -176,7 +183,7 @@ pure subroutine drift_kepu(dt,r0,mu,alpha,u,fp,c1,c2,c3,iflag)
    end subroutine drift_kepu
 
    pure subroutine drift_kepu_fchk(dt, r0, mu, alpha, u, s, f)
-      !$omp declare simd(drift_kepu_fchk)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Computes the value of f, the function whose root we are trying to find in universal variables
@@ -199,7 +206,7 @@ pure subroutine drift_kepu_fchk(dt, r0, mu, alpha, u, s, f)
    end subroutine drift_kepu_fchk
 
    pure subroutine drift_kepu_guess(dt, r0, mu, alpha, u, s)
-      !$omp declare simd(drift_kepu_guess)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Compute initial guess for solving Kepler's equation using universal variables
@@ -237,7 +244,7 @@ pure subroutine drift_kepu_guess(dt, r0, mu, alpha, u, s)
    end subroutine drift_kepu_guess
 
    pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag)
-      !$omp declare simd(drift_kepu_lag)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Solve Kepler's equation in universal variables using Laguerre's method
@@ -282,7 +289,7 @@ pure subroutine drift_kepu_lag(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag)
    end subroutine drift_kepu_lag
 
    pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag)
-      !$omp declare simd(drift_kepu_new)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Solve Kepler's equation in universal variables using Newton's method
@@ -324,7 +331,7 @@ pure subroutine drift_kepu_new(s, dt, r0, mu, alpha, u, fp, c1, c2, c3, iflag)
    end subroutine drift_kepu_new
 
    pure subroutine drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag)
-      !$omp declare simd(drift_kepu_p3solve)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Computes real root of cubic involved in setting initial guess for solving Kepler's equation in universal variables
@@ -368,7 +375,7 @@ pure subroutine drift_kepu_p3solve(dt, r0, mu, alpha, u, s, iflag)
    end subroutine drift_kepu_p3solve
 
    pure subroutine drift_kepu_stumpff(x, c0, c1, c2, c3)
-      !$omp declare simd(drift_kepu_stumpff)
+      !$omp declare simd
       !! author: David A. Minton
       !!
       !! Compute Stumpff functions needed for Kepler drift in universal variables

diff --git a/src/driftkick/kick.f90 b/src/driftkick/kick.f90
@@ -17,7 +17,7 @@ module subroutine kick_vh_body(self, dt)
 
       associate(n => self%nbody, vh => self%vh, ah => self%ah, status => self%status)
          if (n == 0) return
-         !$omp simd
+         !!$omp simd
          do i = 1, n
             if (status(i) == ACTIVE) vh(:, i) = vh(:, i) + ah(:, i) * dt
          end do

diff --git a/src/helio/helio_drift.f90 b/src/helio/helio_drift.f90
@@ -40,7 +40,7 @@ module subroutine helio_drift_pl(self, cb, config, dt)
             else
                dtp = dt
             end if
-            call drift_one(mu(i), xh(:, i), vb(:, i), dtp, iflag(i))
+            call drift_one(mu(i), xh(1, i), xh(2, i), xh(3, i), vb(1, i), vb(2, i), vb(3, i), dtp, iflag(i))
          end do 
          if (any(iflag(1:npl) /= 0)) then
             do i = 1, npl
@@ -125,7 +125,7 @@ module subroutine helio_drift_tp(self, cb, config, dt)
                else
                   dtp = dt
                end if
-               call drift_one(mu(i), xh(:, i), vb(:, i), dtp, iflag(i))
+               call drift_one(mu(i), xh(1, i), xh(2, i), xh(3, i), vb(1, i), vb(2, i), vb(3, i), dtp, iflag(i))
                if (iflag(i) /= 0) status = DISCARDED_DRIFTERR
             end if
          end do

diff --git a/src/helio/helio_step.f90 b/src/helio/helio_step.f90
@@ -1,7 +1,7 @@
 submodule(helio_classes) s_helio_step
    use swiftest
 contains
-   module subroutine helio_step_system(cb, pl, tp, config)
+   module subroutine helio_step_system(self, config)
       !! author: David A. Minton
       !!
       !! Step massive bodies and and active test particles ahead in heliocentric coordinates
@@ -10,11 +10,15 @@ module subroutine helio_step_system(cb, pl, tp, config)
       !! Adapted from David E. Kaufmann's Swifter routine helio_step.f90
       implicit none
       ! Arguments
-      class(helio_cb),               intent(inout) :: cb      !! Helio central body object  
-      class(helio_pl),               intent(inout) :: pl      !! Helio central body object  
-      class(helio_tp),               intent(inout) :: tp      !! Helio central body object  
+      class(helio_nbody_system),     intent(inout) :: self    !! Helio nbody system object
       class(swiftest_configuration), intent(in)    :: config  !! Input collection of on parameters 
 
+      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)
       associate(ntp => tp%nbody, npl => pl%nbody, t => config%t, dt => config%dt)
          call pl%set_rhill(cb)
          call tp%set_beg_end(xbeg = pl%xh)
@@ -24,6 +28,10 @@ module subroutine helio_step_system(cb, pl, tp, config)
             call tp%step(cb, pl, config, t, dt)
          end if
       end associate
+      end select
+      end select
+      end select
+      return
    end subroutine helio_step_system 
 
    module subroutine helio_step_pl(self, cb, config, t, dt)

diff --git a/src/modules/helio_classes.f90 b/src/modules/helio_classes.f90
@@ -7,6 +7,16 @@ module helio_classes
    use rmvs_classes, only : rmvs_cb, rmvs_pl, rmvs_tp, rmvs_nbody_system
    implicit none
 
+
+   !********************************************************************************************************************************
+   !  helio_nbody_system class definitions and method interfaces
+   !********************************************************************************************************************************
+   type, public, extends(rmvs_nbody_system) :: helio_nbody_system
+   contains
+      private
+      procedure, public :: step          => helio_step_system
+   end type helio_nbody_system
+
    !********************************************************************************************************************************
    ! helio_cb class definitions and method interfaces
    !*******************************************************************************************************************************
@@ -53,13 +63,6 @@ module helio_classes
       procedure, public :: step        => helio_step_tp             !! Steps the body forward one stepsize
    end type helio_tp
 
-   !********************************************************************************************************************************
-   !  helio_nbody_system class definitions and method interfaces
-   !********************************************************************************************************************************
-   type, public, extends(rmvs_nbody_system) :: helio_nbody_system
-   contains
-      private
-   end type helio_nbody_system
 
    interface
 
@@ -171,19 +174,16 @@ module subroutine helio_setup_tp(self,n)
          integer,         intent(in)    :: n    !! Number of test particles to allocate
       end subroutine helio_setup_tp
 
-      module subroutine helio_step_system(cb, pl, tp, config)
-         use swiftest_classes
+      module subroutine helio_step_system(self, config)
+         use swiftest_classes, only : swiftest_configuration
          implicit none
-         class(helio_cb),               intent(inout) :: cb      !! Helio central body object  
-         class(helio_pl),               intent(inout) :: pl      !! Helio massive body object  
-         class(helio_tp),               intent(inout) :: tp      !! Helio test particle object  
+         class(helio_nbody_system),     intent(inout) :: self    !! Helio nbody system object
          class(swiftest_configuration), intent(in)    :: config  !! Input collection of  configuration parameters 
       end subroutine helio_step_system
 
       module subroutine helio_step_pl(self, cb, config, t, dt)
          use swiftest_classes, only : swiftest_cb, swiftest_configuration
          implicit none
-         ! Arguments
          class(helio_pl),               intent(inout) :: self   !! WHM massive body particle data structure
          class(swiftest_cb),            intent(inout) :: cb     !! Swiftest central body particle data structure
          class(swiftest_configuration), intent(in)    :: config !! Input collection of