Added adaptive interaction loop timing. Right now all the diagnostic …

…logging is done in the loop. Eventually I will consolidate this inside the walltimer methods.

Makefile.Defines

@@ -67,15 +67,15 @@ GWARNINGS = -Wall -Warray-bounds  -Wimplicit-interface -Wextra -Warray-temporari
 GPRODUCTION = -O2 -ffree-line-length-none $(GPAR)
 
 
-#FFLAGS  = $(IDEBUG) $(SIMDVEC) $(PAR)
-#FFASTFLAGS  = $(IDEBUG) $(SIMDVEC) $(PAR)
-FFLAGS = $(IPRODUCTION) $(STRICTREAL)
-FFASTFLAGS = $(IPRODUCTION) -fp-model fast
+#FFLAGS  = $(IDEBUG)  #$(SIMDVEC) $(PAR)
+#FFASTFLAGS  = $(IDEBUG) #$(SIMDVEC) $(PAR)
+FFLAGS = $(IPRODUCTION) $(STRICTREAL) #$(ADVIXE_FLAGS)
+FFASTFLAGS = $(IPRODUCTION) -fp-model fast #$(ADVIXE_FLAGS)
 FORTRAN = ifort
 AR     = xiar
 
 #FORTRAN = gfortran
-#FFLAGS =  $(GDEBUG) $(GMEM) $(GPAR)
+#FFLAGS =  $(GDEBUG) # $(GMEM) $(GPAR)
 #FFLAGS =  $(GPRODUCTION) -g -fbacktrace #-fcheck=all #-Wall AR     = ar # DO NOT include in CFLAGS the "-c" option to compile object only
 # this is done explicitly as needed in the Makefile
 

src/io/io.f90

@@ -465,6 +465,7 @@ module function io_get_token(buffer, ifirst, ilast, ierr) result(token)
       return
    end function io_get_token
 
+
    module subroutine io_log_one_message(file, message)
       !! author: David A. Minton
       !!
@@ -545,7 +546,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg)
 
       ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible
       associate(param => self) 
-         rewind(unit)
+         open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg)
          do
             read(unit = unit, fmt = linefmt, end = 1, err = 667, iomsg = iomsg) line
             line_trim = trim(adjustl(line))
@@ -705,6 +706,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg)
             end if
          end do
          1 continue
+         close(unit)
          iostat = 0
 
          ! Do basic sanity checks on the input values
@@ -814,6 +816,7 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg)
             param%ladaptive_interactions = .true.
             param%lflatten_interactions = .true.
             call io_log_start(param, INTERACTION_TIMER_LOG_OUT, "Interaction loop timer logfile")
+            call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "Diagnostic values: loop style, time count, nplpl, metric")
          case("TRIANGULAR")
             param%ladaptive_interactions = .false.
             param%lflatten_interactions = .false.
@@ -836,8 +839,9 @@ module subroutine io_param_reader(self, unit, iotype, v_list, iostat, iomsg)
 
       end associate
 
-      667 continue
       return 
+      667 continue
+      write(*,*) "Error reading param file: ", trim(adjustl(iomsg))
    end subroutine io_param_reader
 
 
@@ -1613,19 +1617,18 @@ module subroutine io_read_in_param(self, param_file_name)
       class(swiftest_parameters),intent(inout) :: self             !! Current run configuration parameters
       character(len=*), intent(in)             :: param_file_name !! Parameter input file name (i.e. param.in)
       ! Internals
-      integer(I4B)            :: ierr = 0                !! Input error code
-      character(STRMAX)       :: errmsg           !! Error message in UDIO procedure
+      integer(I4B)      :: ierr = 0 !! Input error code
+      character(STRMAX) :: errmsg   !! Error message in UDIO procedure
 
       ! Read in name of parameter file
       write(*, *) 'Parameter input file is ', trim(adjustl(param_file_name))
       write(*, *) ' '
-      100 format(A)
-      open(unit = LUN, file = param_file_name, status = 'old', iostat = ierr, err = 667, iomsg = errmsg)
+      self%param_file_name = param_file_name
 
       !! todo: Currently this procedure does not work in user-defined derived-type input mode 
       !!    as the newline characters are ignored in the input file when compiled in ifort.
 
-      !read(LUN,'(DT)', iostat= ierr, iomsg = errmsg) param
+      !read(LUN,'(DT)', iostat= ierr, iomsg = errmsg) self
       call self%reader(LUN, iotype= "none", v_list = [self%integrator], iostat = ierr, iomsg = errmsg)
       if (ierr == 0) return
 

src/kick/kick.f90

@@ -16,14 +16,54 @@ module subroutine kick_getacch_int_pl(self, param)
       ! Internals
       type(interaction_timer), save :: itimer
       logical, save :: lfirst
+      character(len=STRMAX) :: tstr, nstr, cstr, mstr, lstyle
+      character(len=1) :: schar
+
+      if (param%ladaptive_interactions) then
+         if (lfirst) then
+            call itimer%time_this_loop(param, self, self%nplpl)
+            lfirst = .false.
+         else
+            if (itimer%check(param, self%nplpl)) call itimer%time_this_loop(param, self, self%nplpl)
+         end if
+      end if
+
+      if (itimer%is_on) then
+         write(tstr,*) param%t
+         write(schar,'(I1)') itimer%stage
+         if (itimer%stage == 1) then
+            call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "kick_getacch_int_pl: loop timer turned on at t = " // trim(adjustl(tstr)))
+         end if
+         call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "kick_getacch_int_pl: stage " // schar )
+      end if
 
-      if (lfirst) call itimer%reset(param)
       if (param%lflatten_interactions) then
          call kick_getacch_int_all_flat_pl(self%nbody, self%nplpl, self%k_plpl, self%xh, self%Gmass, self%radius, self%ah)
       else
          call kick_getacch_int_all_triangular_pl(self%nbody, self%nbody, self%xh, self%Gmass, self%radius, self%ah)
       end if
 
+      if (param%ladaptive_interactions) then 
+         if (itimer%is_on) then
+            if (param%lflatten_interactions) then
+               write(lstyle,*) "FLAT"
+            else
+               write(lstyle,*) "TRIANGULAR"
+            end if
+            call itimer%adapt(param, self, self%nplpl)
+            write(schar,'(I1)') itimer%stage
+            write(nstr,*) self%nplpl
+            write(cstr,*) itimer%count_finish_step
+            select case(itimer%stage)
+            case(1)
+               write(mstr,*) itimer%stage1_metric
+            case(2)
+               write(mstr,*) itimer%stage2_metric
+            end select
+            call io_log_one_message(INTERACTION_TIMER_LOG_OUT, trim(adjustl(lstyle)) // " " // trim(adjustl(cstr)) // " " // trim(adjustl(nstr)) // " " // trim(adjustl(mstr)))
+         end if
+      end if
+
       return
    end subroutine kick_getacch_int_pl
 

src/modules/swiftest_classes.f90

@@ -89,6 +89,7 @@ module swiftest_classes
    !>    Each paramter is initialized to a default values. 
    type :: swiftest_parameters
       integer(I4B)         :: integrator     = UNKNOWN_INTEGRATOR !! Symbolic name of the nbody integrator  used
+      character(STRMAX)    :: param_file_name = "param.in"        !! The default name of the parameter input file
       integer(I4B)         :: maxid          = -1                 !! The current maximum particle id number 
       real(DP)             :: t0             = -1.0_DP            !! Integration start time
       real(DP)             :: t              = -1.0_DP            !! Integration current time
@@ -1165,7 +1166,7 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg)
          implicit none
          class(swiftest_body),         intent(inout) :: self   !! Swiftest massive body particle data structure
          class(swiftest_nbody_system), intent(inout) :: system !! Swiftest nbody_system_object
-         class(swiftest_parameters),   intent(in)    :: param  !! Current run configuration parameters 
+         class(swiftest_parameters),   intent(inout) :: param  !! Current run configuration parameters 
          real(DP),                     intent(in)    :: t      !! Current time
          logical,                      intent(in)    :: lbeg   !! Optional argument that determines whether or not this is the beginning or end of the step
       end subroutine user_kick_getacch_body

src/modules/walltime_classes.f90

@@ -3,7 +3,7 @@ module walltime_classes
    !!
    !! Classes and methods used to compute elasped wall time
    use swiftest_globals
-   use swiftest_classes, only : swiftest_parameters
+   use swiftest_classes, only : swiftest_parameters, swiftest_pl
    implicit none
    public
 
@@ -24,28 +24,23 @@ module walltime_classes
    end type walltimer
 
    type, extends(walltimer) :: interaction_timer
-      integer(I8B)           :: max_interactions = huge(1_I8B)
-      integer(I4B)           :: step_counter
-      integer(I8B)           :: count_previous
-      logical                :: lflatten_interaction_old
+      integer(I8B) :: max_interactions = huge(1_I8B) !! Stores the number of pl-pl interactions that failed when attempting to flatten (e.g. out of memory). Adapting won't occur if ninteractions > max_interactions
+      integer(I8B) :: last_interactions = 0          !! Number of interactions that were computed last time. The timer is only run if there has been a change to the number of interactions
+      integer(I4B) :: step_counter = 0               !! Number of steps that have elapsed since the last timed loop
+      logical      :: is_on = .false.                !! The loop timer is currently active
+      integer(I4B) :: stage = 1                      !! The stage of the loop timing (1 or 2)
+      logical      :: stage1_is_flattened            !! Logical flag indicating whether stage1 was done with a flat loop (.true.) or triangular loop (.false.)
+      integer(I8B) :: stage1_ninteractions           !! Number of interactions computed during stage 1
+      real(DP)     :: stage1_metric                  !! Metric used to judge the performance of a timed loop (e.g. (count_finish_step - count_start_step) / ninteractions)
+      real(DP)     :: stage2_metric                  !! Metric used to judge the performance of a timed loop (e.g. (count_finish_step - count_start_step) / ninteractions)
    contains
-      procedure :: reset  => walltime_interaction_reset  !! Resets the interaction loop timer, and saves the current value of the array flatten parameter
+      procedure :: adapt => walltime_interaction_adapt !! Runs the interaction loop adaptation algorithm on an interaction loop
+      procedure :: check => walltime_interaction_check !! Checks whether or not the loop should be timed and starts the timer if the conditions for starting are met
+      procedure :: flip  => walltime_interaction_flip_loop_style  !! Flips the interaction loop style from FLAT to TRIANGULAR or vice vers
+      procedure :: time_this_loop => walltime_interaction_time_this_loop !! Starts the interaction loop timer
    end type interaction_timer
 
    interface
-      module subroutine walltime_interaction_reset(self, param)
-         use swiftest_classes, only : swiftest_parameters
-         implicit none
-         class(interaction_timer),   intent(inout) :: self  !! Walltimer object
-         class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters
-      end subroutine walltime_interaction_reset 
-
-      module subroutine walltime_interaction_io_log_start(param)
-         use swiftest_classes, only : swiftest_parameters
-         implicit none
-         class(swiftest_parameters), intent(in) :: param
-      end subroutine walltime_interaction_io_log_start
-
       module subroutine walltime_finish(self, nsubsteps, message, param)
          use swiftest_classes, only : swiftest_parameters
          implicit none
@@ -70,25 +65,45 @@ module subroutine walltime_start(self, param)
       end subroutine walltime_start
    end interface
 
-   contains
+   interface
+      module subroutine walltime_interaction_adapt(self, param, pl, ninteractions)
+         use swiftest_classes, only : swiftest_parameters
+         implicit none
+         class(interaction_timer),   intent(inout) :: self          !! Interaction loop timer object
+         class(swiftest_parameters), intent(inout) :: param         !! Current run configuration parameters
+         class(swiftest_pl),         intent(inout) :: pl            !! Swiftest massive body object
+         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
+      end subroutine walltime_interaction_adapt
 
-      module subroutine walltime_interaction_reset(self, param)
-         !! author: David A. Minton
-         !!
-         !! Resets the interaction loop timer, and saves the current value of the array flatten parameter
+      module function walltime_interaction_check(self, param, ninteractions) result(ltimeit)
          use swiftest_classes, only : swiftest_parameters
          implicit none
-         ! Arguments
-         class(interaction_timer),   intent(inout) :: self  !! Walltimer object
+         class(interaction_timer),   intent(inout) :: self    !! Interaction loop timer object
+         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
+      end function walltime_interaction_check
+
+      module subroutine walltime_interaction_flip_loop_style(self, param, pl)
+         use swiftest_classes, only : swiftest_parameters, swiftest_pl
+         implicit none
+         class(interaction_timer),   intent(inout) :: self  !! Interaction loop timer object
          class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters
+         class(swiftest_pl),         intent(inout) :: pl    !! Swiftest massive body object
+      end subroutine walltime_interaction_flip_loop_style
 
-         self%lflatten_interaction_old = param%lflatten_interactions
-         self%step_counter = 0
-         call walltime_reset(self, param)
+      module subroutine walltime_interaction_time_this_loop(self, param, pl, ninteractions)
+         use swiftest_classes, only : swiftest_parameters, swiftest_pl
+         implicit none
+         class(interaction_timer),   intent(inout) :: self          !! Interaction loop timer object
+         class(swiftest_parameters), intent(inout) :: param         !! Current run configuration parameters
+         class(swiftest_pl),         intent(inout) :: pl            !! Swiftest massive body object
+         integer(I8B),               intent(in)    :: ninteractions !! Current number of interactions (used to normalize the timed loop)
+      end subroutine walltime_interaction_time_this_loop
 
-         return
-      end subroutine walltime_interaction_reset 
+   end interface
 
+   contains
 
       module subroutine walltime_finish(self, nsubsteps, message, param)
          !! author: David A. Minton
@@ -167,4 +182,111 @@ module subroutine walltime_start(self, param)
       end subroutine walltime_start
 
 
+      module subroutine walltime_interaction_adapt(self, param, pl, ninteractions)
+         !! author: David A. Minton
+         !!
+         !! Determines which of the two loop styles is fastest and keeps that one
+         implicit none
+         class(interaction_timer),   intent(inout) :: self          !! Walltimer object
+         class(swiftest_parameters), intent(inout) :: param         !! Current run configuration parameters
+         class(swiftest_pl),         intent(inout) :: pl            !! Swiftest massive body object
+         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
+
+         ! Record the elapsed time 
+         call system_clock(self%count_finish_step)
+
+         select case(self%stage)
+         case(1)
+            self%stage1_metric = (self%count_finish_step - self%count_start_step) / real(ninteractions, kind=DP)
+         case(2)
+            self%stage2_metric = (self%count_finish_step - self%count_start_step) / real(ninteractions, kind=DP)
+            self%is_on = .false.
+            self%step_counter = 0
+            if (self%stage1_metric < self%stage2_metric) call self%flip(param, pl)  ! Go back to the original style, otherwise keep the stage2 style
+         end select
+
+         return
+      end subroutine walltime_interaction_adapt
+
+
+      module function walltime_interaction_check(self, param, ninteractions) result(ltimeit)
+         !! author: David A. Minton
+         !!
+         !! Checks whether or not the loop should be timed and starts the timer if the conditions for starting are met
+         implicit none
+         ! Arguments
+         class(interaction_timer),   intent(inout) :: self          !! Walltimer object
+         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
+            ltimeit = (self%stage == 2)
+         else
+            self%step_counter = max(self%step_counter + 1, INTERACTION_TIMER_CADENCE)
+            ltimeit = .false.
+            if (self%step_counter == INTERACTION_TIMER_CADENCE) then
+               ltimeit = (ninteractions /= self%last_interactions)
+               if (ltimeit) self%stage = 1
+            end if
+         end if
+         self%is_on = ltimeit
+
+         return
+      end function walltime_interaction_check
+
+
+      module subroutine walltime_interaction_flip_loop_style(self, param, pl)
+         !! author: David A. Minton
+         !!
+         !! Flips the interaction loop style from FLAT to TRIANGULAR or vice versa
+         implicit none
+         ! Arguments
+         class(interaction_timer),   intent(inout) :: self  !! Interaction loop timer object
+         class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters
+         class(swiftest_pl),         intent(inout) :: pl    !! Swiftest massive body object 
+
+         param%lflatten_interactions = .not. param%lflatten_interactions
+         if (param%lflatten_interactions) then
+            call pl%flatten(param)
+         else
+            if (allocated(pl%k_plpl)) deallocate(pl%k_plpl)
+         end if
+
+         return
+      end subroutine walltime_interaction_flip_loop_style
+
+
+      module subroutine walltime_interaction_time_this_loop(self, param, pl, ninteractions)
+         !! author: David A. Minton
+         !!
+         !! Resets the interaction loop timer, and saves the current value of the array flatten parameter
+         implicit none
+         ! Arguments
+         class(interaction_timer),   intent(inout) :: self          !! Interaction loop timer object
+         class(swiftest_parameters), intent(inout) :: param         !! Current run configuration parameters
+         class(swiftest_pl),         intent(inout) :: pl            !! Swiftest massive body object
+         integer(I8B),               intent(in)    :: ninteractions !! Current number of interactions (used to normalize the timed loop)
+
+         self%is_on = .true.
+         self%step_counter = 0
+         select case(self%stage)
+         case(1)
+            self%stage1_ninteractions = ninteractions      
+            self%stage1_is_flattened = param%lflatten_interactions
+         case(2)
+            param%lflatten_interactions = self%stage1_is_flattened
+            call self%flip(param, pl) 
+         case default
+            self%stage = 1
+         end select
+         call self%reset(param)
+
+         return
+      end subroutine walltime_interaction_time_this_loop
+
+
 end module walltime_classes