From 78d1ca4168a4d2e59811899404fd67446b61fc0d Mon Sep 17 00:00:00 2001 From: David A Minton Date: Mon, 20 Sep 2021 18:08:28 -0400 Subject: [PATCH] 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 | 10 +- src/io/io.f90 | 17 +-- src/kick/kick.f90 | 42 ++++++- src/modules/swiftest_classes.f90 | 3 +- src/modules/walltime_classes.f90 | 184 +++++++++++++++++++++++++------ src/symba/symba_io.f90 | 7 +- src/symba/symba_kick.f90 | 52 +++++++++ src/user/user_getacch.f90 | 2 +- 8 files changed, 268 insertions(+), 49 deletions(-) diff --git a/Makefile.Defines b/Makefile.Defines index 9e06d56ba..16ce3afc3 100644 --- a/Makefile.Defines +++ b/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 diff --git a/src/io/io.f90 b/src/io/io.f90 index 4915fba27..cf9c6a8a9 100644 --- a/src/io/io.f90 +++ b/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 diff --git a/src/kick/kick.f90 b/src/kick/kick.f90 index 2626c6d34..edc054caf 100644 --- a/src/kick/kick.f90 +++ b/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 diff --git a/src/modules/swiftest_classes.f90 b/src/modules/swiftest_classes.f90 index 46cf56369..2c3b4721e 100644 --- a/src/modules/swiftest_classes.f90 +++ b/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 diff --git a/src/modules/walltime_classes.f90 b/src/modules/walltime_classes.f90 index 97f6fb520..97db74f73 100644 --- a/src/modules/walltime_classes.f90 +++ b/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 \ No newline at end of file diff --git a/src/symba/symba_io.f90 b/src/symba/symba_io.f90 index 3f481d9b4..bea4e9de3 100644 --- a/src/symba/symba_io.f90 +++ b/src/symba/symba_io.f90 @@ -27,11 +27,10 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms character(len=*),parameter :: linefmt = '(A)' associate(param => self) - + open(unit = unit, file = param%param_file_name, status = 'old', err = 667, iomsg = iomsg) call random_seed(size = nseeds) if (allocated(param%seed)) deallocate(param%seed) allocate(param%seed(nseeds)) - rewind(unit) do read(unit = unit, fmt = linefmt, iostat = iostat, end = 1, err = 667, iomsg = iomsg) line line_trim = trim(adjustl(line)) @@ -79,6 +78,7 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms end if end do 1 continue + close(unit) if (self%GMTINY < 0.0_DP) then write(iomsg,*) "GMTINY invalid or not set: ", self%GMTINY @@ -104,8 +104,9 @@ module subroutine symba_io_param_reader(self, unit, iotype, v_list, iostat, ioms iostat = 0 - 667 continue return + 667 continue + write(*,*) "Error reading SyMBA parameters in param file: ", trim(adjustl(iomsg)) end subroutine symba_io_param_reader diff --git a/src/symba/symba_kick.f90 b/src/symba/symba_kick.f90 index e9b7d0405..119899ae4 100644 --- a/src/symba/symba_kick.f90 +++ b/src/symba/symba_kick.f90 @@ -13,6 +13,30 @@ module subroutine symba_kick_getacch_int_pl(self, param) ! Arguments class(symba_pl), intent(inout) :: self !! SyMBA massive body object class(swiftest_parameters), intent(inout) :: param !! Current swiftest run configuration parameter + ! Internals + type(interaction_timer), save :: itimer + logical, save :: lfirst + character(len=STRMAX) :: tstr, nstr, cstr, mstr + character(len=10) :: 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, "symba_kick_getacch_int_pl: loop timer turned on at t = " // trim(adjustl(tstr))) + end if + call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "symba_kick_getacch_int_pl: stage " // schar ) + end if if (param%lflatten_interactions) then call kick_getacch_int_all_flat_pl(self%nbody, self%nplplm, self%k_plpl, self%xh, self%Gmass, self%radius, self%ah) @@ -20,6 +44,34 @@ module subroutine symba_kick_getacch_int_pl(self, param) call kick_getacch_int_all_triangular_pl(self%nbody, self%nplm, 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 - itimer%count_start_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, adjustl(lstyle) // " " // trim(adjustl(cstr)) // " " // trim(adjustl(nstr)) // " " // trim(adjustl(mstr))) + if (param%lflatten_interactions) then + write(lstyle,*) "FLAT " + else + write(lstyle,*) "TRIANGULAR" + end if + call io_log_one_message(INTERACTION_TIMER_LOG_OUT, "The fastest loop method tested is " // trim(adjustl(lstyle))) + + end if + end if + return end subroutine symba_kick_getacch_int_pl diff --git a/src/user/user_getacch.f90 b/src/user/user_getacch.f90 index 2775de3dd..a85ec3143 100644 --- a/src/user/user_getacch.f90 +++ b/src/user/user_getacch.f90 @@ -11,7 +11,7 @@ module subroutine user_kick_getacch_body(self, system, param, t, lbeg) ! Arguments 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 user parameters + class(swiftest_parameters), intent(inout) :: param !! Current run configuration parameters user parameters real(DP), intent(in) :: t !! Current time logical, intent(in) :: lbeg !! Logical flag that determines whether or not this is the beginning or end of the ste