diff --git a/example/ginzburg_landau/main.f90 b/example/ginzburg_landau/main.f90 index 935d99da..94e1112a 100644 --- a/example/ginzburg_landau/main.f90 +++ b/example/ginzburg_landau/main.f90 @@ -3,6 +3,7 @@ program demo use LightKrylov, only: wp => dp use LightKrylov use LightKrylov_Logger + use LightKrylov_Timing, only: timer => global_lightkrylov_timer use Ginzburg_Landau implicit none @@ -45,6 +46,9 @@ program demo !> Set up logging call logger_setup() + !> Set up timing + call timer%initialize() + !> Initialize physical parameters. call initialize_parameters() @@ -80,4 +84,9 @@ program demo !> Save eigenvectors to disk. call save_npy("example/ginzburg_landau/eigenvectors.npy", eigenvectors) + ! Print timing info for exponential propagator + call A%finalize_timer() + ! Finalize timing + call timer%finalize() + end program demo diff --git a/example/roessler/main.f90 b/example/roessler/main.f90 index 830f814a..120db726 100644 --- a/example/roessler/main.f90 +++ b/example/roessler/main.f90 @@ -10,8 +10,9 @@ program demo use LightKrylov use LightKrylov, only: wp => dp use LightKrylov_Logger - use lightkrylov_IterativeSolvers, only: gmres_rdp + use LightKrylov_Timing, only: timer => global_lightkrylov_timer use LightKrylov_Utils + use lightkrylov_IterativeSolvers, only: gmres_rdp ! Roessler system use Roessler use Roessler_OTD @@ -41,6 +42,7 @@ program demo real(wp), dimension(r, r) :: Lr ! IO character(len=20) :: data_fmt, header_fmt + !integer, allocatable :: logunits(:) write (header_fmt, *) '(22X,*(A,2X))' write (data_fmt, *) '(A22,*(1X,F15.6))' @@ -49,6 +51,9 @@ program demo call logger_setup() call logger%configure(level=error_level, time_stamp=.false.) + ! Set up timing + call timer%initialize() + ! Initialize baseflow and perturbation state vectors call bf%zero(); call dx%zero(); call residual%zero() @@ -87,6 +92,11 @@ program demo sys%jacobian = jacobian() sys%jacobian%X = bf + ! Reset eval timer + call sys%reset_timer() + ! Reset system timers + call timer%reset_all() + ! Set tolerance tol = 1e-12_wp @@ -129,6 +139,11 @@ program demo ! Compute the stability of the orbit sys%jacobian = floquet_operator() sys%jacobian%X = bf ! <- periodic orbit + + ! Reset eval timer + call sys%reset_timer() + ! Reset system timers + call timer%reset_all() M = 0.0_wp Id = eye(npts) @@ -238,4 +253,9 @@ program demo call rename(report_file_OTD_LE, 'example/roessler/PO-chaos_LE.txt') print *, '' + ! Print timing info for system evaulations + call sys%finalize_timer() + ! Finalize timing + call timer%finalize() + end program demo diff --git a/src/AbstractLinops.f90 b/src/AbstractLinops.f90 index b07d5c7c..d089534f 100644 --- a/src/AbstractLinops.f90 +++ b/src/AbstractLinops.f90 @@ -12,6 +12,7 @@ module LightKrylov_AbstractLinops use stdlib_optval, only: optval use LightKrylov_Logger use LightKrylov_Constants + use LightKrylov_Timing use LightKrylov_Utils use LightKrylov_AbstractVectors implicit none @@ -29,11 +30,19 @@ module LightKrylov_AbstractLinops !! @endwarning integer, private :: matvec_counter = 0 integer, private :: rmatvec_counter = 0 + type(lightkrylov_timer) :: matvec_timer = lightkrylov_timer('matvec timer') + type(lightkrylov_timer) :: rmatvec_timer = lightkrylov_timer('rmatvec timer') contains procedure, pass(self), public :: get_counter !! Return matvec/rmatvec counter value procedure, pass(self), public :: reset_counter !! Reset matvec/rmatvec counter + procedure, pass(self), public :: print_timer_info + !! Print current timer information + procedure, pass(self), public :: reset_timer + !! Reset current timer information + procedure, pass(self), public :: finalize_timer + !! Finalize timers and print complete history_info end type abstract_linop !------------------------------------------------------------------------------ @@ -448,7 +457,7 @@ pure integer function get_counter(self, trans) result(count) end if end function get_counter - subroutine reset_counter(self, trans, procedure, counter) + subroutine reset_counter(self, trans, procedure, counter, reset_timer) class(abstract_linop), intent(inout) :: self logical, intent(in) :: trans !! matvec or rmatvec? @@ -456,11 +465,15 @@ subroutine reset_counter(self, trans, procedure, counter) !! name of the caller routine integer, optional, intent(in) :: counter !! optional flag to reset to an integer other than zero. + logical, optional, intent(in) :: reset_timer + !! optional flag to reset also the timers (while saving the timing data) ! internals integer :: counter_, count_old + logical :: reset_timer_ character(len=128) :: msg counter_ = optval(counter, 0) count_old = self%get_counter(trans) + reset_timer_ = optval(reset_timer, .true.) if ( count_old /= 0 .or. counter_ /= 0) then if (trans) then write(msg,'(A,I0,A,I0,A)') 'Total number of rmatvecs: ', count_old, '. Resetting counter to ', counter_, '.' @@ -472,9 +485,46 @@ subroutine reset_counter(self, trans, procedure, counter) self%matvec_counter = counter_ end if end if + if (reset_timer_) call self%reset_timer(trans) return end subroutine reset_counter + subroutine print_timer_info(self, trans) + !! Getter routine to print the current timing information for the system evaluation + class(abstract_linop), intent(inout) :: self + logical, optional, intent(in) :: trans + ! internal + logical :: transpose + transpose = optval(trans, .false.) + if (transpose) then + call self%rmatvec_timer%print_info() + else + call self%matvec_timer%print_info() + end if + end subroutine print_timer_info + + subroutine reset_timer(self, trans, save_history) + !! Setter routine to reset the system evaluation timer + class(abstract_linop), intent(inout) :: self + logical, optional, intent(in) :: trans + logical, optional, intent(in) :: save_history + ! internal + logical :: transpose + transpose = optval(trans, .false.) + if (transpose) then + call self%rmatvec_timer%reset(save_history) + else + call self%matvec_timer%reset(save_history) + end if + end subroutine reset_timer + + subroutine finalize_timer(self) + !! Setter routine to reset the system evaluation timer + class(abstract_linop), intent(inout) :: self + call self%matvec_timer%finalize() + call self%rmatvec_timer%finalize() + end subroutine finalize_timer + !--------------------------------------------------------------------- !----- Wrappers for matvec/rmatvec to increment counters ----- !--------------------------------------------------------------------- @@ -483,8 +533,16 @@ subroutine apply_matvec_rsp(self, vec_in, vec_out) class(abstract_linop_rsp), intent(inout) :: self class(abstract_vector_rsp), intent(in) :: vec_in class(abstract_vector_rsp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%matvec_counter = self%matvec_counter + 1 + write(msg,'(I0,1X,A)') self%matvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='matvec') + call self%matvec_timer%start() call self%matvec(vec_in, vec_out) + call self%matvec_timer%stop() + write(msg,'(I0,1X,A)') self%matvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='matvec') return end subroutine apply_matvec_rsp @@ -492,16 +550,32 @@ subroutine apply_rmatvec_rsp(self, vec_in, vec_out) class(abstract_linop_rsp), intent(inout) :: self class(abstract_vector_rsp), intent(in) :: vec_in class(abstract_vector_rsp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%rmatvec_counter = self%rmatvec_counter + 1 + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') + call self%rmatvec_timer%start() call self%rmatvec(vec_in, vec_out) + call self%rmatvec_timer%stop() + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') return end subroutine apply_rmatvec_rsp subroutine apply_matvec_rdp(self, vec_in, vec_out) class(abstract_linop_rdp), intent(inout) :: self class(abstract_vector_rdp), intent(in) :: vec_in class(abstract_vector_rdp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%matvec_counter = self%matvec_counter + 1 + write(msg,'(I0,1X,A)') self%matvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='matvec') + call self%matvec_timer%start() call self%matvec(vec_in, vec_out) + call self%matvec_timer%stop() + write(msg,'(I0,1X,A)') self%matvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='matvec') return end subroutine apply_matvec_rdp @@ -509,16 +583,32 @@ subroutine apply_rmatvec_rdp(self, vec_in, vec_out) class(abstract_linop_rdp), intent(inout) :: self class(abstract_vector_rdp), intent(in) :: vec_in class(abstract_vector_rdp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%rmatvec_counter = self%rmatvec_counter + 1 + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') + call self%rmatvec_timer%start() call self%rmatvec(vec_in, vec_out) + call self%rmatvec_timer%stop() + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') return end subroutine apply_rmatvec_rdp subroutine apply_matvec_csp(self, vec_in, vec_out) class(abstract_linop_csp), intent(inout) :: self class(abstract_vector_csp), intent(in) :: vec_in class(abstract_vector_csp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%matvec_counter = self%matvec_counter + 1 + write(msg,'(I0,1X,A)') self%matvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='matvec') + call self%matvec_timer%start() call self%matvec(vec_in, vec_out) + call self%matvec_timer%stop() + write(msg,'(I0,1X,A)') self%matvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='matvec') return end subroutine apply_matvec_csp @@ -526,16 +616,32 @@ subroutine apply_rmatvec_csp(self, vec_in, vec_out) class(abstract_linop_csp), intent(inout) :: self class(abstract_vector_csp), intent(in) :: vec_in class(abstract_vector_csp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%rmatvec_counter = self%rmatvec_counter + 1 + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') + call self%rmatvec_timer%start() call self%rmatvec(vec_in, vec_out) + call self%rmatvec_timer%stop() + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') return end subroutine apply_rmatvec_csp subroutine apply_matvec_cdp(self, vec_in, vec_out) class(abstract_linop_cdp), intent(inout) :: self class(abstract_vector_cdp), intent(in) :: vec_in class(abstract_vector_cdp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%matvec_counter = self%matvec_counter + 1 + write(msg,'(I0,1X,A)') self%matvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='matvec') + call self%matvec_timer%start() call self%matvec(vec_in, vec_out) + call self%matvec_timer%stop() + write(msg,'(I0,1X,A)') self%matvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='matvec') return end subroutine apply_matvec_cdp @@ -543,8 +649,16 @@ subroutine apply_rmatvec_cdp(self, vec_in, vec_out) class(abstract_linop_cdp), intent(inout) :: self class(abstract_vector_cdp), intent(in) :: vec_in class(abstract_vector_cdp), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%rmatvec_counter = self%rmatvec_counter + 1 + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') + call self%rmatvec_timer%start() call self%rmatvec(vec_in, vec_out) + call self%rmatvec_timer%stop() + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') return end subroutine apply_rmatvec_cdp diff --git a/src/AbstractLinops.fypp b/src/AbstractLinops.fypp index b36daafb..1e7c8f96 100644 --- a/src/AbstractLinops.fypp +++ b/src/AbstractLinops.fypp @@ -14,6 +14,7 @@ module LightKrylov_AbstractLinops use stdlib_optval, only: optval use LightKrylov_Logger use LightKrylov_Constants + use LightKrylov_Timing use LightKrylov_Utils use LightKrylov_AbstractVectors implicit none @@ -31,11 +32,19 @@ module LightKrylov_AbstractLinops !! @endwarning integer, private :: matvec_counter = 0 integer, private :: rmatvec_counter = 0 + type(lightkrylov_timer) :: matvec_timer = lightkrylov_timer('matvec timer') + type(lightkrylov_timer) :: rmatvec_timer = lightkrylov_timer('rmatvec timer') contains procedure, pass(self), public :: get_counter !! Return matvec/rmatvec counter value procedure, pass(self), public :: reset_counter !! Reset matvec/rmatvec counter + procedure, pass(self), public :: print_timer_info + !! Print current timer information + procedure, pass(self), public :: reset_timer + !! Reset current timer information + procedure, pass(self), public :: finalize_timer + !! Finalize timers and print complete history_info end type abstract_linop #:for kind, type in RC_KINDS_TYPES @@ -196,7 +205,7 @@ contains end if end function get_counter - subroutine reset_counter(self, trans, procedure, counter) + subroutine reset_counter(self, trans, procedure, counter, reset_timer) class(abstract_linop), intent(inout) :: self logical, intent(in) :: trans !! matvec or rmatvec? @@ -204,11 +213,15 @@ contains !! name of the caller routine integer, optional, intent(in) :: counter !! optional flag to reset to an integer other than zero. + logical, optional, intent(in) :: reset_timer + !! optional flag to reset also the timers (while saving the timing data) ! internals integer :: counter_, count_old + logical :: reset_timer_ character(len=128) :: msg counter_ = optval(counter, 0) count_old = self%get_counter(trans) + reset_timer_ = optval(reset_timer, .true.) if ( count_old /= 0 .or. counter_ /= 0) then if (trans) then write(msg,'(A,I0,A,I0,A)') 'Total number of rmatvecs: ', count_old, '. Resetting counter to ', counter_, '.' @@ -220,9 +233,46 @@ contains self%matvec_counter = counter_ end if end if + if (reset_timer_) call self%reset_timer(trans) return end subroutine reset_counter + subroutine print_timer_info(self, trans) + !! Getter routine to print the current timing information for the system evaluation + class(abstract_linop), intent(inout) :: self + logical, optional, intent(in) :: trans + ! internal + logical :: transpose + transpose = optval(trans, .false.) + if (transpose) then + call self%rmatvec_timer%print_info() + else + call self%matvec_timer%print_info() + end if + end subroutine print_timer_info + + subroutine reset_timer(self, trans, save_history) + !! Setter routine to reset the system evaluation timer + class(abstract_linop), intent(inout) :: self + logical, optional, intent(in) :: trans + logical, optional, intent(in) :: save_history + ! internal + logical :: transpose + transpose = optval(trans, .false.) + if (transpose) then + call self%rmatvec_timer%reset(save_history) + else + call self%matvec_timer%reset(save_history) + end if + end subroutine reset_timer + + subroutine finalize_timer(self) + !! Setter routine to reset the system evaluation timer + class(abstract_linop), intent(inout) :: self + call self%matvec_timer%finalize() + call self%rmatvec_timer%finalize() + end subroutine finalize_timer + !--------------------------------------------------------------------- !----- Wrappers for matvec/rmatvec to increment counters ----- !--------------------------------------------------------------------- @@ -232,8 +282,16 @@ contains class(abstract_linop_${type[0]}$${kind}$), intent(inout) :: self class(abstract_vector_${type[0]}$${kind}$), intent(in) :: vec_in class(abstract_vector_${type[0]}$${kind}$), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%matvec_counter = self%matvec_counter + 1 + write(msg,'(I0,1X,A)') self%matvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='matvec') + call self%matvec_timer%start() call self%matvec(vec_in, vec_out) + call self%matvec_timer%stop() + write(msg,'(I0,1X,A)') self%matvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='matvec') return end subroutine apply_matvec_${type[0]}$${kind}$ @@ -241,8 +299,16 @@ contains class(abstract_linop_${type[0]}$${kind}$), intent(inout) :: self class(abstract_vector_${type[0]}$${kind}$), intent(in) :: vec_in class(abstract_vector_${type[0]}$${kind}$), intent(out) :: vec_out + ! internal + character(len=128) :: msg self%rmatvec_counter = self%rmatvec_counter + 1 + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') + call self%rmatvec_timer%start() call self%rmatvec(vec_in, vec_out) + call self%rmatvec_timer%stop() + write(msg,'(I0,1X,A)') self%rmatvec_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='rmatvec') return end subroutine apply_rmatvec_${type[0]}$${kind}$ #:endfor diff --git a/src/AbstractSystems.f90 b/src/AbstractSystems.f90 index b8169f52..d6dab7d6 100644 --- a/src/AbstractSystems.f90 +++ b/src/AbstractSystems.f90 @@ -4,6 +4,7 @@ module LightKrylov_AbstractSystems use stdlib_optval, only: optval use LightKrylov_Logger use LightKrylov_Constants + use LightKrylov_Timing use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops implicit none @@ -16,11 +17,18 @@ module LightKrylov_AbstractSystems type, abstract, public :: abstract_system private integer :: eval_counter = 0 + type(lightkrylov_timer) :: eval_timer = lightkrylov_timer('system eval timer') contains procedure, pass(self), public :: get_eval_counter !! Return eval counter value procedure, pass(self), public :: reset_eval_counter !! Reset eval counter + procedure, pass(self), public :: print_timer_info + !! Print current timer information + procedure, pass(self), public :: reset_timer + !! Reset current timer information + procedure, pass(self), public :: finalize_timer + !! Finalize timer and print complete history end type abstract_system !---------------------------------------------------------------------------- @@ -203,25 +211,49 @@ pure integer function get_eval_counter(self) result(count) count = self%eval_counter end function get_eval_counter - subroutine reset_eval_counter(self, procedure, counter) + subroutine reset_eval_counter(self, procedure, counter, reset_timer) class(abstract_system), intent(inout) :: self character(len=*), intent(in) :: procedure !! name of the caller routine integer, optional, intent(in) :: counter !! optional flag to reset to an integer other than zero. + logical, optional, intent(in) :: reset_timer + !! optional flag to reset also the timers (while saving the timing data) ! internals integer :: counter_, count_old + logical :: reset_timer_ character(len=128) :: msg counter_ = optval(counter, 0) count_old = self%get_eval_counter() + reset_timer_ = optval(reset_timer, .true.) if (count_old /= 0 .or. counter_ /= 0) then write(msg,'(A,I0,A,I0,A)') 'Total number of evals: ', count_old, '. Resetting counter to ', counter_, '.' call logger%log_message(msg, module=this_module, procedure='reset_eval_counter('//trim(procedure)//')') self%eval_counter = counter_ end if + if (reset_timer_) call self%reset_timer() return end subroutine reset_eval_counter + subroutine print_timer_info(self) + !! Getter routine to print the current timing information for the system evaluation + class(abstract_system), intent(inout) :: self + call self%eval_timer%print_info() + end subroutine print_timer_info + + subroutine reset_timer(self, save_history) + !! Setter routine to reset the system evaluation timer + class(abstract_system), intent(inout) :: self + logical, optional, intent(in) :: save_history + call self%eval_timer%reset(save_history) + end subroutine reset_timer + + subroutine finalize_timer(self) + !! Setter routine to reset the system evaluation timer + class(abstract_system), intent(inout) :: self + call self%eval_timer%finalize() + end subroutine finalize_timer + !--------------------------------------------------------------------- !----- Wrapper for system response to increment counters ----- !--------------------------------------------------------------------- @@ -231,8 +263,16 @@ subroutine eval_rsp(self, vec_in, vec_out, atol) class(abstract_vector_rsp), intent(in) :: vec_in class(abstract_vector_rsp), intent(out) :: vec_out real(sp), intent(in) :: atol + ! internal + character(len=128) :: msg self%eval_counter = self%eval_counter + 1 + write(msg,'(I0,1X,A)') self%eval_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='response') + call self%eval_timer%start() call self%response(vec_in, vec_out, atol) + call self%eval_timer%stop() + write(msg,'(I0,1X,A)') self%eval_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='response') return end subroutine eval_rsp subroutine eval_rdp(self, vec_in, vec_out, atol) @@ -240,8 +280,16 @@ subroutine eval_rdp(self, vec_in, vec_out, atol) class(abstract_vector_rdp), intent(in) :: vec_in class(abstract_vector_rdp), intent(out) :: vec_out real(dp), intent(in) :: atol + ! internal + character(len=128) :: msg self%eval_counter = self%eval_counter + 1 + write(msg,'(I0,1X,A)') self%eval_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='response') + call self%eval_timer%start() call self%response(vec_in, vec_out, atol) + call self%eval_timer%stop() + write(msg,'(I0,1X,A)') self%eval_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='response') return end subroutine eval_rdp subroutine eval_csp(self, vec_in, vec_out, atol) @@ -249,8 +297,16 @@ subroutine eval_csp(self, vec_in, vec_out, atol) class(abstract_vector_csp), intent(in) :: vec_in class(abstract_vector_csp), intent(out) :: vec_out real(sp), intent(in) :: atol + ! internal + character(len=128) :: msg self%eval_counter = self%eval_counter + 1 + write(msg,'(I0,1X,A)') self%eval_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='response') + call self%eval_timer%start() call self%response(vec_in, vec_out, atol) + call self%eval_timer%stop() + write(msg,'(I0,1X,A)') self%eval_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='response') return end subroutine eval_csp subroutine eval_cdp(self, vec_in, vec_out, atol) @@ -258,8 +314,16 @@ subroutine eval_cdp(self, vec_in, vec_out, atol) class(abstract_vector_cdp), intent(in) :: vec_in class(abstract_vector_cdp), intent(out) :: vec_out real(dp), intent(in) :: atol + ! internal + character(len=128) :: msg self%eval_counter = self%eval_counter + 1 + write(msg,'(I0,1X,A)') self%eval_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='response') + call self%eval_timer%start() call self%response(vec_in, vec_out, atol) + call self%eval_timer%stop() + write(msg,'(I0,1X,A)') self%eval_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='response') return end subroutine eval_cdp diff --git a/src/AbstractSystems.fypp b/src/AbstractSystems.fypp index 95d02de2..9ce639b2 100644 --- a/src/AbstractSystems.fypp +++ b/src/AbstractSystems.fypp @@ -6,6 +6,7 @@ module LightKrylov_AbstractSystems use stdlib_optval, only: optval use LightKrylov_Logger use LightKrylov_Constants + use LightKrylov_Timing use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops implicit none @@ -18,11 +19,18 @@ module LightKrylov_AbstractSystems type, abstract, public :: abstract_system private integer :: eval_counter = 0 + type(lightkrylov_timer) :: eval_timer = lightkrylov_timer('system eval timer') contains procedure, pass(self), public :: get_eval_counter !! Return eval counter value procedure, pass(self), public :: reset_eval_counter !! Reset eval counter + procedure, pass(self), public :: print_timer_info + !! Print current timer information + procedure, pass(self), public :: reset_timer + !! Reset current timer information + procedure, pass(self), public :: finalize_timer + !! Finalize timer and print complete history end type abstract_system #:for kind, type in RC_KINDS_TYPES @@ -81,25 +89,49 @@ contains count = self%eval_counter end function get_eval_counter - subroutine reset_eval_counter(self, procedure, counter) + subroutine reset_eval_counter(self, procedure, counter, reset_timer) class(abstract_system), intent(inout) :: self character(len=*), intent(in) :: procedure !! name of the caller routine integer, optional, intent(in) :: counter !! optional flag to reset to an integer other than zero. + logical, optional, intent(in) :: reset_timer + !! optional flag to reset also the timers (while saving the timing data) ! internals integer :: counter_, count_old + logical :: reset_timer_ character(len=128) :: msg counter_ = optval(counter, 0) count_old = self%get_eval_counter() + reset_timer_ = optval(reset_timer, .true.) if (count_old /= 0 .or. counter_ /= 0) then write(msg,'(A,I0,A,I0,A)') 'Total number of evals: ', count_old, '. Resetting counter to ', counter_, '.' call logger%log_message(msg, module=this_module, procedure='reset_eval_counter('//trim(procedure)//')') self%eval_counter = counter_ end if + if (reset_timer_) call self%reset_timer() return end subroutine reset_eval_counter + subroutine print_timer_info(self) + !! Getter routine to print the current timing information for the system evaluation + class(abstract_system), intent(inout) :: self + call self%eval_timer%print_info() + end subroutine print_timer_info + + subroutine reset_timer(self, save_history) + !! Setter routine to reset the system evaluation timer + class(abstract_system), intent(inout) :: self + logical, optional, intent(in) :: save_history + call self%eval_timer%reset(save_history) + end subroutine reset_timer + + subroutine finalize_timer(self) + !! Setter routine to reset the system evaluation timer + class(abstract_system), intent(inout) :: self + call self%eval_timer%finalize() + end subroutine finalize_timer + !--------------------------------------------------------------------- !----- Wrapper for system response to increment counters ----- !--------------------------------------------------------------------- @@ -110,8 +142,16 @@ contains class(abstract_vector_${type[0]}$${kind}$), intent(in) :: vec_in class(abstract_vector_${type[0]}$${kind}$), intent(out) :: vec_out real(${kind}$), intent(in) :: atol + ! internal + character(len=128) :: msg self%eval_counter = self%eval_counter + 1 + write(msg,'(I0,1X,A)') self%eval_counter, 'start' + call logger%log_debug(msg, module=this_module, procedure='response') + call self%eval_timer%start() call self%response(vec_in, vec_out, atol) + call self%eval_timer%stop() + write(msg,'(I0,1X,A)') self%eval_counter, 'end' + call logger%log_debug(msg, module=this_module, procedure='response') return end subroutine eval_${type[0]}$${kind}$ #:endfor diff --git a/src/BaseKrylov.f90 b/src/BaseKrylov.f90 index b6efe33a..5b3e434b 100644 --- a/src/BaseKrylov.f90 +++ b/src/BaseKrylov.f90 @@ -21,6 +21,7 @@ module lightkrylov_BaseKrylov !------------------------------- use LightKrylov_Constants use LightKrylov_Logger + use LightKrylov_Timing, only: timer => global_lightkrylov_timer, time_lightkrylov use LightKrylov_Utils use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops @@ -675,9 +676,11 @@ subroutine orthonormalize_basis_rsp(X) real(sp) :: R(size(X),size(X)) integer :: info + if (time_lightkrylov()) call timer%start('orthonormalize_basis_rsp') ! internals call qr(X, R, info) call check_info(info, 'qr', module=this_module, procedure='orthonormalize_basis_rsp') + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_rsp') return end subroutine orthonormalize_basis_rsp @@ -699,6 +702,7 @@ subroutine orthogonalize_vector_against_basis_rsp(y, X, info, if_chk_orthonormal ! internals real(sp) :: proj_coefficients(size(X)) + if (time_lightkrylov()) call timer%start('orthonormalize_vector_against_basis_rsp') info = 0 ! optional input argument @@ -735,6 +739,7 @@ subroutine orthogonalize_vector_against_basis_rsp(y, X, info, if_chk_orthonormal call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_vector_against_basis_rsp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_vector_against_basis_rsp') return end subroutine orthogonalize_vector_against_basis_rsp @@ -757,6 +762,7 @@ subroutine orthogonalize_basis_against_basis_rsp(Y, X, info, if_chk_orthonormal, real(sp) :: proj_coefficients(size(X), size(Y)) integer :: i + if (time_lightkrylov()) call timer%start('orthonormalize_basis_against_basis_rsp') info = 0 ! optional input argument @@ -795,6 +801,7 @@ subroutine orthogonalize_basis_against_basis_rsp(Y, X, info, if_chk_orthonormal, call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_basis_against_basis_rsp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_against_basis_rsp') return end subroutine orthogonalize_basis_against_basis_rsp @@ -820,6 +827,7 @@ subroutine DGS_vector_against_basis_rsp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_vector_against_basis_rsp') info = 0 proj_coefficients = zero_rsp; wrk = zero_rsp @@ -841,7 +849,8 @@ subroutine DGS_vector_against_basis_rsp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_vector_against_basis_rsp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_vector_against_basis_rsp') + end subroutine DGS_vector_against_basis_rsp subroutine DGS_basis_against_basis_rsp(y, X, info, if_chk_orthonormal, beta) @@ -865,6 +874,7 @@ subroutine DGS_basis_against_basis_rsp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_basis_against_basis_rsp') info = 0 proj_coefficients = zero_rsp; wrk = zero_rsp @@ -886,7 +896,8 @@ subroutine DGS_basis_against_basis_rsp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_basis_against_basis_rsp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_basis_against_basis_rsp') + end subroutine DGS_basis_against_basis_rsp subroutine initialize_krylov_subspace_rdp(X, X0) @@ -920,9 +931,11 @@ subroutine orthonormalize_basis_rdp(X) real(dp) :: R(size(X),size(X)) integer :: info + if (time_lightkrylov()) call timer%start('orthonormalize_basis_rdp') ! internals call qr(X, R, info) call check_info(info, 'qr', module=this_module, procedure='orthonormalize_basis_rdp') + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_rdp') return end subroutine orthonormalize_basis_rdp @@ -944,6 +957,7 @@ subroutine orthogonalize_vector_against_basis_rdp(y, X, info, if_chk_orthonormal ! internals real(dp) :: proj_coefficients(size(X)) + if (time_lightkrylov()) call timer%start('orthonormalize_vector_against_basis_rdp') info = 0 ! optional input argument @@ -980,6 +994,7 @@ subroutine orthogonalize_vector_against_basis_rdp(y, X, info, if_chk_orthonormal call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_vector_against_basis_rdp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_vector_against_basis_rdp') return end subroutine orthogonalize_vector_against_basis_rdp @@ -1002,6 +1017,7 @@ subroutine orthogonalize_basis_against_basis_rdp(Y, X, info, if_chk_orthonormal, real(dp) :: proj_coefficients(size(X), size(Y)) integer :: i + if (time_lightkrylov()) call timer%start('orthonormalize_basis_against_basis_rdp') info = 0 ! optional input argument @@ -1040,6 +1056,7 @@ subroutine orthogonalize_basis_against_basis_rdp(Y, X, info, if_chk_orthonormal, call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_basis_against_basis_rdp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_against_basis_rdp') return end subroutine orthogonalize_basis_against_basis_rdp @@ -1065,6 +1082,7 @@ subroutine DGS_vector_against_basis_rdp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_vector_against_basis_rdp') info = 0 proj_coefficients = zero_rdp; wrk = zero_rdp @@ -1086,7 +1104,8 @@ subroutine DGS_vector_against_basis_rdp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_vector_against_basis_rdp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_vector_against_basis_rdp') + end subroutine DGS_vector_against_basis_rdp subroutine DGS_basis_against_basis_rdp(y, X, info, if_chk_orthonormal, beta) @@ -1110,6 +1129,7 @@ subroutine DGS_basis_against_basis_rdp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_basis_against_basis_rdp') info = 0 proj_coefficients = zero_rdp; wrk = zero_rdp @@ -1131,7 +1151,8 @@ subroutine DGS_basis_against_basis_rdp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_basis_against_basis_rdp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_basis_against_basis_rdp') + end subroutine DGS_basis_against_basis_rdp subroutine initialize_krylov_subspace_csp(X, X0) @@ -1165,9 +1186,11 @@ subroutine orthonormalize_basis_csp(X) complex(sp) :: R(size(X),size(X)) integer :: info + if (time_lightkrylov()) call timer%start('orthonormalize_basis_csp') ! internals call qr(X, R, info) call check_info(info, 'qr', module=this_module, procedure='orthonormalize_basis_csp') + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_csp') return end subroutine orthonormalize_basis_csp @@ -1189,6 +1212,7 @@ subroutine orthogonalize_vector_against_basis_csp(y, X, info, if_chk_orthonormal ! internals complex(sp) :: proj_coefficients(size(X)) + if (time_lightkrylov()) call timer%start('orthonormalize_vector_against_basis_csp') info = 0 ! optional input argument @@ -1225,6 +1249,7 @@ subroutine orthogonalize_vector_against_basis_csp(y, X, info, if_chk_orthonormal call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_vector_against_basis_csp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_vector_against_basis_csp') return end subroutine orthogonalize_vector_against_basis_csp @@ -1247,6 +1272,7 @@ subroutine orthogonalize_basis_against_basis_csp(Y, X, info, if_chk_orthonormal, complex(sp) :: proj_coefficients(size(X), size(Y)) integer :: i + if (time_lightkrylov()) call timer%start('orthonormalize_basis_against_basis_csp') info = 0 ! optional input argument @@ -1285,6 +1311,7 @@ subroutine orthogonalize_basis_against_basis_csp(Y, X, info, if_chk_orthonormal, call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_basis_against_basis_csp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_against_basis_csp') return end subroutine orthogonalize_basis_against_basis_csp @@ -1310,6 +1337,7 @@ subroutine DGS_vector_against_basis_csp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_vector_against_basis_csp') info = 0 proj_coefficients = zero_csp; wrk = zero_csp @@ -1331,7 +1359,8 @@ subroutine DGS_vector_against_basis_csp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_vector_against_basis_csp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_vector_against_basis_csp') + end subroutine DGS_vector_against_basis_csp subroutine DGS_basis_against_basis_csp(y, X, info, if_chk_orthonormal, beta) @@ -1355,6 +1384,7 @@ subroutine DGS_basis_against_basis_csp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_basis_against_basis_csp') info = 0 proj_coefficients = zero_csp; wrk = zero_csp @@ -1376,7 +1406,8 @@ subroutine DGS_basis_against_basis_csp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_basis_against_basis_csp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_basis_against_basis_csp') + end subroutine DGS_basis_against_basis_csp subroutine initialize_krylov_subspace_cdp(X, X0) @@ -1410,9 +1441,11 @@ subroutine orthonormalize_basis_cdp(X) complex(dp) :: R(size(X),size(X)) integer :: info + if (time_lightkrylov()) call timer%start('orthonormalize_basis_cdp') ! internals call qr(X, R, info) call check_info(info, 'qr', module=this_module, procedure='orthonormalize_basis_cdp') + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_cdp') return end subroutine orthonormalize_basis_cdp @@ -1434,6 +1467,7 @@ subroutine orthogonalize_vector_against_basis_cdp(y, X, info, if_chk_orthonormal ! internals complex(dp) :: proj_coefficients(size(X)) + if (time_lightkrylov()) call timer%start('orthonormalize_vector_against_basis_cdp') info = 0 ! optional input argument @@ -1470,6 +1504,7 @@ subroutine orthogonalize_vector_against_basis_cdp(y, X, info, if_chk_orthonormal call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_vector_against_basis_cdp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_vector_against_basis_cdp') return end subroutine orthogonalize_vector_against_basis_cdp @@ -1492,6 +1527,7 @@ subroutine orthogonalize_basis_against_basis_cdp(Y, X, info, if_chk_orthonormal, complex(dp) :: proj_coefficients(size(X), size(Y)) integer :: i + if (time_lightkrylov()) call timer%start('orthonormalize_basis_against_basis_cdp') info = 0 ! optional input argument @@ -1530,6 +1566,7 @@ subroutine orthogonalize_basis_against_basis_cdp(Y, X, info, if_chk_orthonormal, call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_basis_against_basis_cdp') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_against_basis_cdp') return end subroutine orthogonalize_basis_against_basis_cdp @@ -1555,6 +1592,7 @@ subroutine DGS_vector_against_basis_cdp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_vector_against_basis_cdp') info = 0 proj_coefficients = zero_cdp; wrk = zero_cdp @@ -1576,7 +1614,8 @@ subroutine DGS_vector_against_basis_cdp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_vector_against_basis_cdp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_vector_against_basis_cdp') + end subroutine DGS_vector_against_basis_cdp subroutine DGS_basis_against_basis_cdp(y, X, info, if_chk_orthonormal, beta) @@ -1600,6 +1639,7 @@ subroutine DGS_basis_against_basis_cdp(y, X, info, if_chk_orthonormal, beta) ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_basis_against_basis_cdp') info = 0 proj_coefficients = zero_cdp; wrk = zero_cdp @@ -1621,7 +1661,8 @@ subroutine DGS_basis_against_basis_cdp(y, X, info, if_chk_orthonormal, beta) call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_basis_against_basis_cdp') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_basis_against_basis_cdp') + end subroutine DGS_basis_against_basis_cdp @@ -1649,6 +1690,7 @@ subroutine qr_no_pivoting_rsp(Q, R, info, tol) ! Deals with the optional args. tolerance = optval(tol, atol_sp) + if (time_lightkrylov()) call timer%start('qr_no_pivoting_rsp') info = 0 ; flag = .false.; R = zero_rsp ; beta = zero_rsp do j = 1, size(Q) if (j > 1) then @@ -1679,7 +1721,8 @@ subroutine qr_no_pivoting_rsp(Q, R, info, tol) ! Normalize column. call Q(j)%scal(one_rsp / beta) enddo - + if (time_lightkrylov()) call timer%stop('qr_no_pivoting_rsp') + return end subroutine qr_no_pivoting_rsp @@ -1704,6 +1747,7 @@ subroutine qr_with_pivoting_rsp(Q, R, perm, info, tol) real(sp) :: Rii(size(Q)) character(len=128) :: msg + if (time_lightkrylov()) call timer%start('qr_with_pivoting_rsp') info = 0 ; kdim = size(Q) R = zero_rsp ; Rii = zero_rsp @@ -1762,7 +1806,8 @@ subroutine qr_with_pivoting_rsp(Q, R, perm, info, tol) enddo enddo qr_step - + if (time_lightkrylov()) call timer%stop('qr_with_pivoting_rsp') + return end subroutine qr_with_pivoting_rsp @@ -1914,6 +1959,7 @@ subroutine qr_no_pivoting_rdp(Q, R, info, tol) ! Deals with the optional args. tolerance = optval(tol, atol_dp) + if (time_lightkrylov()) call timer%start('qr_no_pivoting_rdp') info = 0 ; flag = .false.; R = zero_rdp ; beta = zero_rdp do j = 1, size(Q) if (j > 1) then @@ -1944,7 +1990,8 @@ subroutine qr_no_pivoting_rdp(Q, R, info, tol) ! Normalize column. call Q(j)%scal(one_rdp / beta) enddo - + if (time_lightkrylov()) call timer%stop('qr_no_pivoting_rdp') + return end subroutine qr_no_pivoting_rdp @@ -1969,6 +2016,7 @@ subroutine qr_with_pivoting_rdp(Q, R, perm, info, tol) real(dp) :: Rii(size(Q)) character(len=128) :: msg + if (time_lightkrylov()) call timer%start('qr_with_pivoting_rdp') info = 0 ; kdim = size(Q) R = zero_rdp ; Rii = zero_rdp @@ -2027,7 +2075,8 @@ subroutine qr_with_pivoting_rdp(Q, R, perm, info, tol) enddo enddo qr_step - + if (time_lightkrylov()) call timer%stop('qr_with_pivoting_rdp') + return end subroutine qr_with_pivoting_rdp @@ -2179,6 +2228,7 @@ subroutine qr_no_pivoting_csp(Q, R, info, tol) ! Deals with the optional args. tolerance = optval(tol, atol_sp) + if (time_lightkrylov()) call timer%start('qr_no_pivoting_csp') info = 0 ; flag = .false.; R = zero_rsp ; beta = zero_rsp do j = 1, size(Q) if (j > 1) then @@ -2209,7 +2259,8 @@ subroutine qr_no_pivoting_csp(Q, R, info, tol) ! Normalize column. call Q(j)%scal(one_rsp / beta) enddo - + if (time_lightkrylov()) call timer%stop('qr_no_pivoting_csp') + return end subroutine qr_no_pivoting_csp @@ -2234,6 +2285,7 @@ subroutine qr_with_pivoting_csp(Q, R, perm, info, tol) complex(sp) :: Rii(size(Q)) character(len=128) :: msg + if (time_lightkrylov()) call timer%start('qr_with_pivoting_csp') info = 0 ; kdim = size(Q) R = zero_rsp ; Rii = zero_rsp @@ -2292,7 +2344,8 @@ subroutine qr_with_pivoting_csp(Q, R, perm, info, tol) enddo enddo qr_step - + if (time_lightkrylov()) call timer%stop('qr_with_pivoting_csp') + return end subroutine qr_with_pivoting_csp @@ -2444,6 +2497,7 @@ subroutine qr_no_pivoting_cdp(Q, R, info, tol) ! Deals with the optional args. tolerance = optval(tol, atol_dp) + if (time_lightkrylov()) call timer%start('qr_no_pivoting_cdp') info = 0 ; flag = .false.; R = zero_rdp ; beta = zero_rdp do j = 1, size(Q) if (j > 1) then @@ -2474,7 +2528,8 @@ subroutine qr_no_pivoting_cdp(Q, R, info, tol) ! Normalize column. call Q(j)%scal(one_rdp / beta) enddo - + if (time_lightkrylov()) call timer%stop('qr_no_pivoting_cdp') + return end subroutine qr_no_pivoting_cdp @@ -2499,6 +2554,7 @@ subroutine qr_with_pivoting_cdp(Q, R, perm, info, tol) complex(dp) :: Rii(size(Q)) character(len=128) :: msg + if (time_lightkrylov()) call timer%start('qr_with_pivoting_cdp') info = 0 ; kdim = size(Q) R = zero_rdp ; Rii = zero_rdp @@ -2557,7 +2613,8 @@ subroutine qr_with_pivoting_cdp(Q, R, perm, info, tol) enddo enddo qr_step - + if (time_lightkrylov()) call timer%stop('qr_with_pivoting_cdp') + return end subroutine qr_with_pivoting_cdp @@ -2723,6 +2780,8 @@ subroutine arnoldi_rsp(A, X, H, info, kstart, kend, tol, transpose, blksize) integer, allocatable :: perm(:) integer :: k, i, kdim, kpm, kp, kpp + if (time_lightkrylov()) call timer%start('arnoldi_rsp') + ! Deals with optional non-unity blksize and allocations. p = optval(blksize, 1) ; allocate(res(p)) ; res = zero_rsp allocate(perm(size(H, 2))) ; perm = 0 ; info = 0 @@ -2776,6 +2835,8 @@ subroutine arnoldi_rsp(A, X, H, info, kstart, kend, tol, transpose, blksize) enddo blk_arnoldi + if (time_lightkrylov()) call timer%stop('arnoldi_rsp') + return end subroutine arnoldi_rsp @@ -2808,6 +2869,8 @@ subroutine arnoldi_rdp(A, X, H, info, kstart, kend, tol, transpose, blksize) integer, allocatable :: perm(:) integer :: k, i, kdim, kpm, kp, kpp + if (time_lightkrylov()) call timer%start('arnoldi_rdp') + ! Deals with optional non-unity blksize and allocations. p = optval(blksize, 1) ; allocate(res(p)) ; res = zero_rdp allocate(perm(size(H, 2))) ; perm = 0 ; info = 0 @@ -2861,6 +2924,8 @@ subroutine arnoldi_rdp(A, X, H, info, kstart, kend, tol, transpose, blksize) enddo blk_arnoldi + if (time_lightkrylov()) call timer%stop('arnoldi_rdp') + return end subroutine arnoldi_rdp @@ -2893,6 +2958,8 @@ subroutine arnoldi_csp(A, X, H, info, kstart, kend, tol, transpose, blksize) integer, allocatable :: perm(:) integer :: k, i, kdim, kpm, kp, kpp + if (time_lightkrylov()) call timer%start('arnoldi_csp') + ! Deals with optional non-unity blksize and allocations. p = optval(blksize, 1) ; allocate(res(p)) ; res = zero_rsp allocate(perm(size(H, 2))) ; perm = 0 ; info = 0 @@ -2946,6 +3013,8 @@ subroutine arnoldi_csp(A, X, H, info, kstart, kend, tol, transpose, blksize) enddo blk_arnoldi + if (time_lightkrylov()) call timer%stop('arnoldi_csp') + return end subroutine arnoldi_csp @@ -2978,6 +3047,8 @@ subroutine arnoldi_cdp(A, X, H, info, kstart, kend, tol, transpose, blksize) integer, allocatable :: perm(:) integer :: k, i, kdim, kpm, kp, kpp + if (time_lightkrylov()) call timer%start('arnoldi_cdp') + ! Deals with optional non-unity blksize and allocations. p = optval(blksize, 1) ; allocate(res(p)) ; res = zero_rdp allocate(perm(size(H, 2))) ; perm = 0 ; info = 0 @@ -3031,6 +3102,8 @@ subroutine arnoldi_cdp(A, X, H, info, kstart, kend, tol, transpose, blksize) enddo blk_arnoldi + if (time_lightkrylov()) call timer%stop('arnoldi_cdp') + return end subroutine arnoldi_cdp @@ -3065,6 +3138,7 @@ subroutine lanczos_bidiagonalization_rsp(A, U, V, B, info, kstart, kend, tol) real(sp) :: alpha, beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_bidiagonalization_rsp') info = 0 ! Krylov subspace dimension. @@ -3115,6 +3189,8 @@ subroutine lanczos_bidiagonalization_rsp(A, U, V, B, info, kstart, kend, tol) enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_bidiagonalization_rsp') + return end subroutine lanczos_bidiagonalization_rsp @@ -3143,6 +3219,7 @@ subroutine lanczos_bidiagonalization_rdp(A, U, V, B, info, kstart, kend, tol) real(dp) :: alpha, beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_bidiagonalization_rdp') info = 0 ! Krylov subspace dimension. @@ -3193,6 +3270,8 @@ subroutine lanczos_bidiagonalization_rdp(A, U, V, B, info, kstart, kend, tol) enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_bidiagonalization_rdp') + return end subroutine lanczos_bidiagonalization_rdp @@ -3221,6 +3300,7 @@ subroutine lanczos_bidiagonalization_csp(A, U, V, B, info, kstart, kend, tol) complex(sp) :: alpha, beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_bidiagonalization_csp') info = 0 ! Krylov subspace dimension. @@ -3271,6 +3351,8 @@ subroutine lanczos_bidiagonalization_csp(A, U, V, B, info, kstart, kend, tol) enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_bidiagonalization_csp') + return end subroutine lanczos_bidiagonalization_csp @@ -3299,6 +3381,7 @@ subroutine lanczos_bidiagonalization_cdp(A, U, V, B, info, kstart, kend, tol) complex(dp) :: alpha, beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_bidiagonalization_cdp') info = 0 ! Krylov subspace dimension. @@ -3349,6 +3432,8 @@ subroutine lanczos_bidiagonalization_cdp(A, U, V, B, info, kstart, kend, tol) enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_bidiagonalization_cdp') + return end subroutine lanczos_bidiagonalization_cdp @@ -3373,6 +3458,8 @@ subroutine lanczos_tridiagonalization_rsp(A, X, T, info, kstart, kend, tol) real(sp) :: beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_tridiagonalization_rsp') + ! Deal with optional args. kdim = size(X) - 1 k_start = optval(kstart, 1) @@ -3400,6 +3487,8 @@ subroutine lanczos_tridiagonalization_rsp(A, X, T, info, kstart, kend, tol) endif enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_tridiagonalization_rsp') + return end subroutine lanczos_tridiagonalization_rsp @@ -3440,6 +3529,8 @@ subroutine lanczos_tridiagonalization_rdp(A, X, T, info, kstart, kend, tol) real(dp) :: beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_tridiagonalization_rdp') + ! Deal with optional args. kdim = size(X) - 1 k_start = optval(kstart, 1) @@ -3467,6 +3558,8 @@ subroutine lanczos_tridiagonalization_rdp(A, X, T, info, kstart, kend, tol) endif enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_tridiagonalization_rdp') + return end subroutine lanczos_tridiagonalization_rdp @@ -3507,6 +3600,8 @@ subroutine lanczos_tridiagonalization_csp(A, X, T, info, kstart, kend, tol) real(sp) :: beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_tridiagonalization_csp') + ! Deal with optional args. kdim = size(X) - 1 k_start = optval(kstart, 1) @@ -3534,6 +3629,8 @@ subroutine lanczos_tridiagonalization_csp(A, X, T, info, kstart, kend, tol) endif enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_tridiagonalization_csp') + return end subroutine lanczos_tridiagonalization_csp @@ -3574,6 +3671,8 @@ subroutine lanczos_tridiagonalization_cdp(A, X, T, info, kstart, kend, tol) real(dp) :: beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_tridiagonalization_cdp') + ! Deal with optional args. kdim = size(X) - 1 k_start = optval(kstart, 1) @@ -3601,6 +3700,8 @@ subroutine lanczos_tridiagonalization_cdp(A, X, T, info, kstart, kend, tol) endif enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_tridiagonalization_cdp') + return end subroutine lanczos_tridiagonalization_cdp diff --git a/src/BaseKrylov.fypp b/src/BaseKrylov.fypp index c9da5f7c..4ea999b2 100644 --- a/src/BaseKrylov.fypp +++ b/src/BaseKrylov.fypp @@ -23,6 +23,7 @@ module lightkrylov_BaseKrylov !------------------------------- use LightKrylov_Constants use LightKrylov_Logger + use LightKrylov_Timing, only: timer => global_lightkrylov_timer, time_lightkrylov use LightKrylov_Utils use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops @@ -620,9 +621,11 @@ contains ${type}$ :: R(size(X),size(X)) integer :: info + if (time_lightkrylov()) call timer%start('orthonormalize_basis_${type[0]}$${kind}$') ! internals call qr(X, R, info) call check_info(info, 'qr', module=this_module, procedure='orthonormalize_basis_${type[0]}$${kind}$') + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_${type[0]}$${kind}$') return end subroutine orthonormalize_basis_${type[0]}$${kind}$ @@ -644,6 +647,7 @@ contains ! internals ${type}$ :: proj_coefficients(size(X)) + if (time_lightkrylov()) call timer%start('orthonormalize_vector_against_basis_${type[0]}$${kind}$') info = 0 ! optional input argument @@ -680,6 +684,7 @@ contains call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_vector_against_basis_${type[0]}$${kind}$') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_vector_against_basis_${type[0]}$${kind}$') return end subroutine orthogonalize_vector_against_basis_${type[0]}$${kind}$ @@ -702,6 +707,7 @@ contains ${type}$ :: proj_coefficients(size(X), size(Y)) integer :: i + if (time_lightkrylov()) call timer%start('orthonormalize_basis_against_basis_${type[0]}$${kind}$') info = 0 ! optional input argument @@ -740,6 +746,7 @@ contains call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'orthogonalize_basis_against_basis_${type[0]}$${kind}$') beta = proj_coefficients end if + if (time_lightkrylov()) call timer%stop('orthonormalize_basis_against_basis_${type[0]}$${kind}$') return end subroutine orthogonalize_basis_against_basis_${type[0]}$${kind}$ @@ -765,6 +772,7 @@ contains ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_vector_against_basis_${type[0]}$${kind}$') info = 0 proj_coefficients = zero_${type[0]}$${kind}$; wrk = zero_${type[0]}$${kind}$ @@ -786,7 +794,8 @@ contains call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_vector_against_basis_${type[0]}$${kind}$') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_vector_against_basis_${type[0]}$${kind}$') + end subroutine DGS_vector_against_basis_${type[0]}$${kind}$ subroutine DGS_basis_against_basis_${type[0]}$${kind}$(y, X, info, if_chk_orthonormal, beta) @@ -810,6 +819,7 @@ contains ! optional input argument chk_X_orthonormality = optval(if_chk_orthonormal, .true.) ! default to true! + if (time_lightkrylov()) call timer%start('DGS_basis_against_basis_${type[0]}$${kind}$') info = 0 proj_coefficients = zero_${type[0]}$${kind}$; wrk = zero_${type[0]}$${kind}$ @@ -829,7 +839,8 @@ contains call assert_shape(beta, shape(proj_coefficients), 'beta', this_module, 'DGS_basis_against_basis_${type[0]}$${kind}$') beta = proj_coefficients end if - + if (time_lightkrylov()) call timer%stop('DGS_basis_against_basis_${type[0]}$${kind}$') + end subroutine DGS_basis_against_basis_${type[0]}$${kind}$ #:endfor @@ -859,6 +870,7 @@ contains ! Deals with the optional args. tolerance = optval(tol, atol_${kind}$) + if (time_lightkrylov()) call timer%start('qr_no_pivoting_${type[0]}$${kind}$') info = 0 ; flag = .false.; R = zero_r${kind}$ ; beta = zero_r${kind}$ do j = 1, size(Q) if (j > 1) then @@ -889,7 +901,8 @@ contains ! Normalize column. call Q(j)%scal(one_r${kind}$ / beta) enddo - + if (time_lightkrylov()) call timer%stop('qr_no_pivoting_${type[0]}$${kind}$') + return end subroutine qr_no_pivoting_${type[0]}$${kind}$ @@ -914,6 +927,7 @@ contains ${type}$ :: Rii(size(Q)) character(len=128) :: msg + if (time_lightkrylov()) call timer%start('qr_with_pivoting_${type[0]}$${kind}$') info = 0 ; kdim = size(Q) R = zero_r${kind}$ ; Rii = zero_r${kind}$ @@ -972,7 +986,8 @@ contains enddo enddo qr_step - + if (time_lightkrylov()) call timer%stop('qr_with_pivoting_${type[0]}$${kind}$') + return end subroutine qr_with_pivoting_${type[0]}$${kind}$ @@ -1140,6 +1155,8 @@ contains integer, allocatable :: perm(:) integer :: k, i, kdim, kpm, kp, kpp + if (time_lightkrylov()) call timer%start('arnoldi_${type[0]}$${kind}$') + ! Deals with optional non-unity blksize and allocations. p = optval(blksize, 1) ; allocate(res(p)) ; res = zero_r${kind}$ allocate(perm(size(H, 2))) ; perm = 0 ; info = 0 @@ -1193,6 +1210,8 @@ contains enddo blk_arnoldi + if (time_lightkrylov()) call timer%stop('arnoldi_${type[0]}$${kind}$') + return end subroutine arnoldi_${type[0]}$${kind}$ @@ -1229,6 +1248,7 @@ contains ${type}$ :: alpha, beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_bidiagonalization_${type[0]}$${kind}$') info = 0 ! Krylov subspace dimension. @@ -1279,6 +1299,8 @@ contains enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_bidiagonalization_${type[0]}$${kind}$') + return end subroutine lanczos_bidiagonalization_${type[0]}$${kind}$ @@ -1309,6 +1331,8 @@ contains real(${kind}$) :: beta integer :: k, kdim + if (time_lightkrylov()) call timer%start('lanczos_tridiagonalization_${type[0]}$${kind}$') + ! Deal with optional args. kdim = size(X) - 1 k_start = optval(kstart, 1) @@ -1336,6 +1360,8 @@ contains endif enddo lanczos + if (time_lightkrylov()) call timer%stop('lanczos_tridiagonalization_${type[0]}$${kind}$') + return end subroutine lanczos_tridiagonalization_${type[0]}$${kind}$ diff --git a/src/ExpmLib.f90 b/src/ExpmLib.f90 index 58fde1e5..c8f1f33e 100644 --- a/src/ExpmLib.f90 +++ b/src/ExpmLib.f90 @@ -20,8 +20,8 @@ module lightkrylov_expmlib implicit none private - character(len=*), parameter, private :: this_module = 'LK_ExpmLib' - character(len=*), parameter, private :: this_module_long = 'LightKrylov_ExpmLib' + character(len=*), parameter :: this_module = 'LK_ExpmLib' + character(len=*), parameter :: this_module_long = 'LightKrylov_ExpmLib' public :: abstract_exptA_rsp public :: abstract_exptA_rdp diff --git a/src/ExpmLib.fypp b/src/ExpmLib.fypp index a11e1c75..7c49c5f5 100644 --- a/src/ExpmLib.fypp +++ b/src/ExpmLib.fypp @@ -22,8 +22,8 @@ module lightkrylov_expmlib implicit none private - character(len=*), parameter, private :: this_module = 'LK_ExpmLib' - character(len=*), parameter, private :: this_module_long = 'LightKrylov_ExpmLib' + character(len=*), parameter :: this_module = 'LK_ExpmLib' + character(len=*), parameter :: this_module_long = 'LightKrylov_ExpmLib' #:for kind, type in RC_KINDS_TYPES public :: abstract_exptA_${type[0]}$${kind}$ diff --git a/src/IterativeSolvers.f90 b/src/IterativeSolvers.f90 index 1052a919..ef8877f0 100644 --- a/src/IterativeSolvers.f90 +++ b/src/IterativeSolvers.f90 @@ -31,6 +31,7 @@ module lightkrylov_IterativeSolvers use LightKrylov_Constants Use LightKrylov_Logger use LightKrylov_Utils + use LightKrylov_Timing, only: timer => global_lightkrylov_timer, time_lightkrylov use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops use LightKrylov_BaseKrylov @@ -819,6 +820,7 @@ subroutine eigs_rsp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, ! Eigenvalue selection. procedure(eigvals_select_sp), pointer :: select_ + if (time_lightkrylov()) call timer%start('eigs_rsp') ! Deals with optional parameters. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -920,7 +922,8 @@ subroutine eigs_rsp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, enddo info = niter - + if (time_lightkrylov()) call timer%stop('eigs_rsp') + return end subroutine eigs_rsp @@ -968,6 +971,7 @@ subroutine eigs_rdp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, ! Eigenvalue selection. procedure(eigvals_select_dp), pointer :: select_ + if (time_lightkrylov()) call timer%start('eigs_rdp') ! Deals with optional parameters. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1069,7 +1073,8 @@ subroutine eigs_rdp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, enddo info = niter - + if (time_lightkrylov()) call timer%stop('eigs_rdp') + return end subroutine eigs_rdp @@ -1116,6 +1121,7 @@ subroutine eigs_csp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, ! Eigenvalue selection. procedure(eigvals_select_sp), pointer :: select_ + if (time_lightkrylov()) call timer%start('eigs_csp') ! Deals with optional parameters. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1208,7 +1214,8 @@ subroutine eigs_csp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, enddo info = niter - + if (time_lightkrylov()) call timer%stop('eigs_csp') + return end subroutine eigs_csp @@ -1255,6 +1262,7 @@ subroutine eigs_cdp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, ! Eigenvalue selection. procedure(eigvals_select_dp), pointer :: select_ + if (time_lightkrylov()) call timer%start('eigs_cdp') ! Deals with optional parameters. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1347,7 +1355,8 @@ subroutine eigs_cdp(A, X, eigvals, residuals, info, x0, kdim, select, tolerance, enddo info = niter - + if (time_lightkrylov()) call timer%stop('eigs_cdp') + return end subroutine eigs_cdp @@ -1398,6 +1407,7 @@ subroutine eighs_rsp(A, X, eigvals, residuals, info, x0, kdim, tolerance) real(sp) :: beta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('eighs_rsp') ! Deaks with the optional args. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1461,7 +1471,8 @@ subroutine eighs_rsp(A, X, eigvals, residuals, info, x0, kdim, tolerance) enddo info = k - + if (time_lightkrylov()) call timer%stop('eighs_rsp') + return end subroutine eighs_rsp @@ -1507,6 +1518,7 @@ subroutine eighs_rdp(A, X, eigvals, residuals, info, x0, kdim, tolerance) real(dp) :: beta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('eighs_rdp') ! Deaks with the optional args. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1570,7 +1582,8 @@ subroutine eighs_rdp(A, X, eigvals, residuals, info, x0, kdim, tolerance) enddo info = k - + if (time_lightkrylov()) call timer%stop('eighs_rdp') + return end subroutine eighs_rdp @@ -1616,6 +1629,7 @@ subroutine eighs_csp(A, X, eigvals, residuals, info, x0, kdim, tolerance) complex(sp) :: beta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('eighs_csp') ! Deaks with the optional args. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1679,7 +1693,8 @@ subroutine eighs_csp(A, X, eigvals, residuals, info, x0, kdim, tolerance) enddo info = k - + if (time_lightkrylov()) call timer%stop('eighs_csp') + return end subroutine eighs_csp @@ -1725,6 +1740,7 @@ subroutine eighs_cdp(A, X, eigvals, residuals, info, x0, kdim, tolerance) complex(dp) :: beta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('eighs_cdp') ! Deaks with the optional args. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -1788,7 +1804,8 @@ subroutine eighs_cdp(A, X, eigvals, residuals, info, x0, kdim, tolerance) enddo info = k - + if (time_lightkrylov()) call timer%stop('eighs_cdp') + return end subroutine eighs_cdp @@ -1834,6 +1851,7 @@ subroutine svds_rsp(A, U, S, V, residuals, info, u0, kdim, tolerance) real(sp) :: tol, u0_norm character(len=256) :: msg + if (time_lightkrylov()) call timer%start('svds_rsp') ! Deals with the optional arguments. nsv = size(U) kdim_ = optval(kdim, 4*nsv) @@ -1894,7 +1912,8 @@ subroutine svds_rsp(A, U, S, V, residuals, info, u0, kdim, tolerance) call V(i)%axpby(one_rsp, Vwrk(j), vmat(j, i)) enddo enddo - + if (time_lightkrylov()) call timer%stop('svds_rsp') + return end subroutine svds_rsp @@ -1935,6 +1954,7 @@ subroutine svds_rdp(A, U, S, V, residuals, info, u0, kdim, tolerance) real(dp) :: tol, u0_norm character(len=256) :: msg + if (time_lightkrylov()) call timer%start('svds_rdp') ! Deals with the optional arguments. nsv = size(U) kdim_ = optval(kdim, 4*nsv) @@ -1995,7 +2015,8 @@ subroutine svds_rdp(A, U, S, V, residuals, info, u0, kdim, tolerance) call V(i)%axpby(one_rdp, Vwrk(j), vmat(j, i)) enddo enddo - + if (time_lightkrylov()) call timer%stop('svds_rdp') + return end subroutine svds_rdp @@ -2036,6 +2057,7 @@ subroutine svds_csp(A, U, S, V, residuals, info, u0, kdim, tolerance) real(sp) :: tol, u0_norm character(len=256) :: msg + if (time_lightkrylov()) call timer%start('svds_csp') ! Deals with the optional arguments. nsv = size(U) kdim_ = optval(kdim, 4*nsv) @@ -2096,7 +2118,8 @@ subroutine svds_csp(A, U, S, V, residuals, info, u0, kdim, tolerance) call V(i)%axpby(one_csp, Vwrk(j), vmat(j, i)) enddo enddo - + if (time_lightkrylov()) call timer%stop('svds_csp') + return end subroutine svds_csp @@ -2137,6 +2160,7 @@ subroutine svds_cdp(A, U, S, V, residuals, info, u0, kdim, tolerance) real(dp) :: tol, u0_norm character(len=256) :: msg + if (time_lightkrylov()) call timer%start('svds_cdp') ! Deals with the optional arguments. nsv = size(U) kdim_ = optval(kdim, 4*nsv) @@ -2197,7 +2221,8 @@ subroutine svds_cdp(A, U, S, V, residuals, info, u0, kdim, tolerance) call V(i)%axpby(one_cdp, Vwrk(j), vmat(j, i)) enddo enddo - + if (time_lightkrylov()) call timer%stop('svds_cdp') + return end subroutine svds_cdp @@ -2256,6 +2281,7 @@ subroutine gmres_rsp(A, b, x, info, rtol, atol, preconditioner, options, transpo class(abstract_vector_rsp), allocatable :: dx, wrk character(len=256) :: msg + if (time_lightkrylov()) call timer%start('gmres_rsp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_sp) atol_ = optval(atol, atol_sp) @@ -2398,6 +2424,7 @@ subroutine gmres_rsp(A, b, x, info, rtol, atol, preconditioner, options, transpo end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('gmres_rsp') return end subroutine gmres_rsp @@ -2452,6 +2479,7 @@ subroutine gmres_rdp(A, b, x, info, rtol, atol, preconditioner, options, transpo class(abstract_vector_rdp), allocatable :: dx, wrk character(len=256) :: msg + if (time_lightkrylov()) call timer%start('gmres_rdp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_dp) atol_ = optval(atol, atol_dp) @@ -2594,6 +2622,7 @@ subroutine gmres_rdp(A, b, x, info, rtol, atol, preconditioner, options, transpo end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('gmres_rdp') return end subroutine gmres_rdp @@ -2648,6 +2677,7 @@ subroutine gmres_csp(A, b, x, info, rtol, atol, preconditioner, options, transpo class(abstract_vector_csp), allocatable :: dx, wrk character(len=256) :: msg + if (time_lightkrylov()) call timer%start('gmres_csp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_sp) atol_ = optval(atol, atol_sp) @@ -2790,6 +2820,7 @@ subroutine gmres_csp(A, b, x, info, rtol, atol, preconditioner, options, transpo end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('gmres_csp') return end subroutine gmres_csp @@ -2844,6 +2875,7 @@ subroutine gmres_cdp(A, b, x, info, rtol, atol, preconditioner, options, transpo class(abstract_vector_cdp), allocatable :: dx, wrk character(len=256) :: msg + if (time_lightkrylov()) call timer%start('gmres_cdp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_dp) atol_ = optval(atol, atol_dp) @@ -2986,6 +3018,7 @@ subroutine gmres_cdp(A, b, x, info, rtol, atol, preconditioner, options, transpo end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('gmres_cdp') return end subroutine gmres_cdp @@ -3050,6 +3083,8 @@ subroutine fgmres_rsp(A, b, x, info, rtol, atol, preconditioner, options, transp class(abstract_vector_rsp), allocatable :: dx character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='fgmres_rsp') + if (time_lightkrylov()) call timer%start('fgmres_rsp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_sp) atol_ = optval(atol, atol_sp) @@ -3191,6 +3226,8 @@ subroutine fgmres_rsp(A, b, x, info, rtol, atol, preconditioner, options, transp end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('fgmres_rsp') + call logger%log_debug('end', module=this_module, procedure='fgmres_rsp') return end subroutine fgmres_rsp @@ -3246,6 +3283,8 @@ subroutine fgmres_rdp(A, b, x, info, rtol, atol, preconditioner, options, transp class(abstract_vector_rdp), allocatable :: dx character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='fgmres_rdp') + if (time_lightkrylov()) call timer%start('fgmres_rdp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_dp) atol_ = optval(atol, atol_dp) @@ -3387,6 +3426,8 @@ subroutine fgmres_rdp(A, b, x, info, rtol, atol, preconditioner, options, transp end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('fgmres_rdp') + call logger%log_debug('end', module=this_module, procedure='fgmres_rdp') return end subroutine fgmres_rdp @@ -3442,6 +3483,8 @@ subroutine fgmres_csp(A, b, x, info, rtol, atol, preconditioner, options, transp class(abstract_vector_csp), allocatable :: dx character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='fgmres_csp') + if (time_lightkrylov()) call timer%start('fgmres_csp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_sp) atol_ = optval(atol, atol_sp) @@ -3583,6 +3626,8 @@ subroutine fgmres_csp(A, b, x, info, rtol, atol, preconditioner, options, transp end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('fgmres_csp') + call logger%log_debug('end', module=this_module, procedure='fgmres_csp') return end subroutine fgmres_csp @@ -3638,6 +3683,8 @@ subroutine fgmres_cdp(A, b, x, info, rtol, atol, preconditioner, options, transp class(abstract_vector_cdp), allocatable :: dx character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='fgmres_cdp') + if (time_lightkrylov()) call timer%start('fgmres_cdp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_dp) atol_ = optval(atol, atol_dp) @@ -3779,6 +3826,8 @@ subroutine fgmres_cdp(A, b, x, info, rtol, atol, preconditioner, options, transp end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('fgmres_cdp') + call logger%log_debug('end', module=this_module, procedure='fgmres_cdp') return end subroutine fgmres_cdp @@ -3829,6 +3878,8 @@ subroutine cg_rsp(A, b, x, info, rtol, atol, preconditioner, options, meta) integer :: i character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='cg_rsp') + if (time_lightkrylov()) call timer%start('cg_rsp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_sp) atol_ = optval(atol, atol_sp) @@ -3911,6 +3962,8 @@ subroutine cg_rsp(A, b, x, info, rtol, atol, preconditioner, options, meta) end if call A%reset_counter(.false., 'cg%post') + if (time_lightkrylov()) call timer%stop('cg_rsp') + call logger%log_debug('end', module=this_module, procedure='cg_rsp') return end subroutine cg_rsp @@ -3954,6 +4007,8 @@ subroutine cg_rdp(A, b, x, info, rtol, atol, preconditioner, options, meta) integer :: i character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='cg_rdp') + if (time_lightkrylov()) call timer%start('cg_rdp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_dp) atol_ = optval(atol, atol_dp) @@ -4036,6 +4091,8 @@ subroutine cg_rdp(A, b, x, info, rtol, atol, preconditioner, options, meta) end if call A%reset_counter(.false., 'cg%post') + if (time_lightkrylov()) call timer%stop('cg_rdp') + call logger%log_debug('end', module=this_module, procedure='cg_rdp') return end subroutine cg_rdp @@ -4079,6 +4136,8 @@ subroutine cg_csp(A, b, x, info, rtol, atol, preconditioner, options, meta) integer :: i character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='cg_csp') + if (time_lightkrylov()) call timer%start('cg_csp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_sp) atol_ = optval(atol, atol_sp) @@ -4161,6 +4220,8 @@ subroutine cg_csp(A, b, x, info, rtol, atol, preconditioner, options, meta) end if call A%reset_counter(.false., 'cg%post') + if (time_lightkrylov()) call timer%stop('cg_csp') + call logger%log_debug('end', module=this_module, procedure='cg_csp') return end subroutine cg_csp @@ -4204,6 +4265,8 @@ subroutine cg_cdp(A, b, x, info, rtol, atol, preconditioner, options, meta) integer :: i character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='cg_cdp') + if (time_lightkrylov()) call timer%start('cg_cdp') ! Deals with the optional args. rtol_ = optval(rtol, rtol_dp) atol_ = optval(atol, atol_dp) @@ -4286,6 +4349,8 @@ subroutine cg_cdp(A, b, x, info, rtol, atol, preconditioner, options, meta) end if call A%reset_counter(.false., 'cg%post') + if (time_lightkrylov()) call timer%stop('cg_cdp') + call logger%log_debug('end', module=this_module, procedure='cg_cdp') return end subroutine cg_cdp diff --git a/src/IterativeSolvers.fypp b/src/IterativeSolvers.fypp index 92fdbf88..2c37a431 100644 --- a/src/IterativeSolvers.fypp +++ b/src/IterativeSolvers.fypp @@ -33,6 +33,7 @@ module lightkrylov_IterativeSolvers use LightKrylov_Constants Use LightKrylov_Logger use LightKrylov_Utils + use LightKrylov_Timing, only: timer => global_lightkrylov_timer, time_lightkrylov use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops use LightKrylov_BaseKrylov @@ -623,6 +624,7 @@ contains ! Eigenvalue selection. procedure(eigvals_select_${kind}$), pointer :: select_ + if (time_lightkrylov()) call timer%start('eigs_${type[0]}$${kind}$') ! Deals with optional parameters. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -728,7 +730,8 @@ contains enddo info = niter - + if (time_lightkrylov()) call timer%stop('eigs_${type[0]}$${kind}$') + return end subroutine eigs_${type[0]}$${kind}$ @@ -785,6 +788,7 @@ contains ${type}$ :: beta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('eighs_${type[0]}$${kind}$') ! Deaks with the optional args. nev = size(X) kdim_ = optval(kdim, 4*nev) @@ -848,7 +852,8 @@ contains enddo info = k - + if (time_lightkrylov()) call timer%stop('eighs_${type[0]}$${kind}$') + return end subroutine eighs_${type[0]}$${kind}$ @@ -896,6 +901,7 @@ contains real(${kind}$) :: tol, u0_norm character(len=256) :: msg + if (time_lightkrylov()) call timer%start('svds_${type[0]}$${kind}$') ! Deals with the optional arguments. nsv = size(U) kdim_ = optval(kdim, 4*nsv) @@ -960,7 +966,8 @@ contains call V(i)%axpby(one_${type[0]}$${kind}$, Vwrk(j), vmat(j, i)) enddo enddo - + if (time_lightkrylov()) call timer%stop('svds_${type[0]}$${kind}$') + return end subroutine svds_${type[0]}$${kind}$ @@ -1021,6 +1028,7 @@ contains class(abstract_vector_${type[0]}$${kind}$), allocatable :: dx, wrk character(len=256) :: msg + if (time_lightkrylov()) call timer%start('gmres_${type[0]}$${kind}$') ! Deals with the optional args. rtol_ = optval(rtol, rtol_${kind}$) atol_ = optval(atol, atol_${kind}$) @@ -1163,6 +1171,7 @@ contains end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('gmres_${type[0]}$${kind}$') return end subroutine gmres_${type[0]}$${kind}$ @@ -1229,6 +1238,8 @@ contains class(abstract_vector_${type[0]}$${kind}$), allocatable :: dx character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='fgmres_${type[0]}$${kind}$') + if (time_lightkrylov()) call timer%start('fgmres_${type[0]}$${kind}$') ! Deals with the optional args. rtol_ = optval(rtol, rtol_${kind}$) atol_ = optval(atol, atol_${kind}$) @@ -1370,6 +1381,8 @@ contains end if call A%reset_counter(trans, 'gmres%post') + if (time_lightkrylov()) call timer%stop('fgmres_${type[0]}$${kind}$') + call logger%log_debug('end', module=this_module, procedure='fgmres_${type[0]}$${kind}$') return end subroutine fgmres_${type[0]}$${kind}$ @@ -1426,6 +1439,8 @@ contains integer :: i character(len=256) :: msg + call logger%log_debug('start', module=this_module, procedure='cg_${type[0]}$${kind}$') + if (time_lightkrylov()) call timer%start('cg_${type[0]}$${kind}$') ! Deals with the optional args. rtol_ = optval(rtol, rtol_${kind}$) atol_ = optval(atol, atol_${kind}$) @@ -1512,6 +1527,8 @@ contains end if call A%reset_counter(.false., 'cg%post') + if (time_lightkrylov()) call timer%stop('cg_${type[0]}$${kind}$') + call logger%log_debug('end', module=this_module, procedure='cg_${type[0]}$${kind}$') return end subroutine cg_${type[0]}$${kind}$ diff --git a/src/LightKrylov.f90 b/src/LightKrylov.f90 index dd95d8c0..d7a09170 100644 --- a/src/LightKrylov.f90 +++ b/src/LightKrylov.f90 @@ -17,6 +17,8 @@ module LightKrylov use LightKrylov_IterativeSolvers ! --> Expmlib use LightKrylov_Expmlib + ! --> Timing utilities + use LightKrylov_Timing ! --> TestTypes implicit none private @@ -140,6 +142,10 @@ module LightKrylov public :: kexpm public :: k_exptA + ! Timer exports + public :: lightkrylov_timer + public :: abstract_watch + contains subroutine greetings() diff --git a/src/LightKrylov.fypp b/src/LightKrylov.fypp index de5c2663..b4c4e181 100644 --- a/src/LightKrylov.fypp +++ b/src/LightKrylov.fypp @@ -19,6 +19,8 @@ module LightKrylov use LightKrylov_IterativeSolvers ! --> Expmlib use LightKrylov_Expmlib + ! --> Timing utilities + use LightKrylov_Timing ! --> TestTypes implicit none private @@ -119,6 +121,10 @@ module LightKrylov public :: kexpm public :: k_exptA + ! Timer exports + public :: lightkrylov_timer + public :: abstract_watch + contains subroutine greetings() diff --git a/src/Logger.f90 b/src/Logger.f90 index 2cda3c5b..e71130ed 100644 --- a/src/Logger.f90 +++ b/src/Logger.f90 @@ -15,7 +15,7 @@ module LightKrylov_Logger implicit none private - character(len=128), parameter, private :: this_module = 'LightKrylov_Logger' + character(len=128), parameter :: this_module = 'LightKrylov_Logger' logical, parameter, private :: exit_on_error = .true. logical, parameter, private :: exit_on_test_error = .true. @@ -33,7 +33,7 @@ module LightKrylov_Logger contains - subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp) + subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp, close_old, iunit) !! Wrapper to set up MPI if needed and initialize log files character(len=*), optional, intent(in) :: logfile !! name of the dedicated LightKrylov logfile @@ -51,6 +51,10 @@ subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp) !! duplicate log messages to stdout? logical, optional, intent(in) :: log_timestamp !! add timestamp to log messages + logical, optional, intent(in) :: close_old + !! close previously opened logfiles (if present?) - stdout is not closed + integer, optional, intent(out) :: iunit + !! log unit identifier ! internals character(len=:), allocatable :: logfile_ @@ -58,8 +62,10 @@ subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp) integer :: log_level_ logical :: log_stdout_ logical :: log_timestamp_ + logical :: close_old_ + logical :: iunit_ ! misc - integer :: stat, iunit + integer :: stat logfile_ = optval(logfile, 'lightkrylov.log') nio_ = optval(nio, 0) @@ -67,6 +73,10 @@ subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp) log_level_ = max(0, min(log_level_, 100)) log_stdout_ = optval(log_stdout, .true.) log_timestamp_ = optval(log_timestamp, .true.) + close_old_ = optval(close_old, .true.) + + ! Flush log units + if (close_old_) call flush_log_units() ! set log level call logger%configure(level=log_level_, time_stamp=log_timestamp_) @@ -83,12 +93,31 @@ subroutine logger_setup(logfile, nio, log_level, log_stdout, log_timestamp) ! log to stdout if (log_stdout_) then - call logger%add_log_unit(6, stat=stat) + call logger%add_log_unit(unit=6, stat=stat) if (stat /= 0) call stop_error('Unable to add stdout to logger.', module=this_module, procedure='logger_setup') end if + + ! return unit if requested + if (present(iunit)) iunit = iunit_ return end subroutine logger_setup + subroutine flush_log_units() + integer, allocatable :: current_log_units(:) + integer :: i, iunit + ! get current units + call logger%configuration(log_units=current_log_units) + ! close all existing units (except stdout if it is included) + do i = 1, size(current_log_units) + iunit = current_log_units(i) + if (iunit == 6) then + call logger%remove_log_unit(unit=iunit) + else + call logger%remove_log_unit(unit=iunit, close_unit=.true.) + end if + end do + end subroutine flush_log_units + subroutine comm_setup() ! internal integer :: ierr, nid, comm_size diff --git a/src/NewtonKrylov.f90 b/src/NewtonKrylov.f90 index 43915948..3b758669 100644 --- a/src/NewtonKrylov.f90 +++ b/src/NewtonKrylov.f90 @@ -2,6 +2,7 @@ module LightKrylov_NewtonKrylov use stdlib_optval, only: optval use LightKrylov_Constants use LightKrylov_Logger + use LightKrylov_Timing, only: timer => global_lightkrylov_timer, time_lightkrylov use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops use LightKrylov_AbstractSystems @@ -109,7 +110,6 @@ subroutine abstract_scheduler_dp(tol, target_tol, rnorm, iter, info) !! Information flag end subroutine abstract_scheduler_dp - end interface contains @@ -148,6 +148,8 @@ subroutine newton_rsp(sys, X, solver, info, tolerance, options, linear_solver_op type(newton_sp_metadata) :: newton_meta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('newton_rsp') + ! Newton-solver tolerance target_tol = optval(tolerance, atol_sp) ! Newton-Krylov options @@ -265,7 +267,8 @@ subroutine newton_rsp(sys, X, solver, info, tolerance, options, linear_solver_op end if call sys%reset_eval_counter('newton%post') - + if (time_lightkrylov()) call timer%stop('newton_rsp') + return end subroutine newton_rsp @@ -303,6 +306,8 @@ subroutine newton_rdp(sys, X, solver, info, tolerance, options, linear_solver_op type(newton_dp_metadata) :: newton_meta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('newton_rdp') + ! Newton-solver tolerance target_tol = optval(tolerance, atol_dp) ! Newton-Krylov options @@ -420,7 +425,8 @@ subroutine newton_rdp(sys, X, solver, info, tolerance, options, linear_solver_op end if call sys%reset_eval_counter('newton%post') - + if (time_lightkrylov()) call timer%stop('newton_rdp') + return end subroutine newton_rdp @@ -458,6 +464,8 @@ subroutine newton_csp(sys, X, solver, info, tolerance, options, linear_solver_op type(newton_sp_metadata) :: newton_meta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('newton_csp') + ! Newton-solver tolerance target_tol = optval(tolerance, atol_sp) ! Newton-Krylov options @@ -575,7 +583,8 @@ subroutine newton_csp(sys, X, solver, info, tolerance, options, linear_solver_op end if call sys%reset_eval_counter('newton%post') - + if (time_lightkrylov()) call timer%stop('newton_csp') + return end subroutine newton_csp @@ -613,6 +622,8 @@ subroutine newton_cdp(sys, X, solver, info, tolerance, options, linear_solver_op type(newton_dp_metadata) :: newton_meta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('newton_cdp') + ! Newton-solver tolerance target_tol = optval(tolerance, atol_dp) ! Newton-Krylov options @@ -730,7 +741,8 @@ subroutine newton_cdp(sys, X, solver, info, tolerance, options, linear_solver_op end if call sys%reset_eval_counter('newton%post') - + if (time_lightkrylov()) call timer%stop('newton_cdp') + return end subroutine newton_cdp diff --git a/src/NewtonKrylov.fypp b/src/NewtonKrylov.fypp index 61114dc4..dbbc74b4 100644 --- a/src/NewtonKrylov.fypp +++ b/src/NewtonKrylov.fypp @@ -4,6 +4,7 @@ module LightKrylov_NewtonKrylov use stdlib_optval, only: optval use LightKrylov_Constants use LightKrylov_Logger + use LightKrylov_Timing, only: timer => global_lightkrylov_timer, time_lightkrylov use LightKrylov_AbstractVectors use LightKrylov_AbstractLinops use LightKrylov_AbstractSystems @@ -97,7 +98,6 @@ module LightKrylov_NewtonKrylov end subroutine abstract_scheduler_${kind}$ #:endfor - end interface contains @@ -137,6 +137,8 @@ contains type(newton_${kind}$_metadata) :: newton_meta character(len=256) :: msg + if (time_lightkrylov()) call timer%start('newton_${type[0]}$${kind}$') + ! Newton-solver tolerance target_tol = optval(tolerance, atol_${kind}$) ! Newton-Krylov options @@ -254,7 +256,8 @@ contains end if call sys%reset_eval_counter('newton%post') - + if (time_lightkrylov()) call timer%stop('newton_${type[0]}$${kind}$') + return end subroutine newton_${type[0]}$${kind}$ diff --git a/src/TestUtils.f90 b/src/TestUtils.f90 index 5c7e807d..9f9a34c5 100644 --- a/src/TestUtils.f90 +++ b/src/TestUtils.f90 @@ -11,8 +11,8 @@ module LightKrylov_TestUtils private - character(len=*), parameter, private :: this_module = 'LK_TUtils' - character(len=*), parameter, private :: this_module_long = 'LightKrylov_TestUtils' + character(len=*), parameter :: this_module = 'LK_TUtils' + character(len=*), parameter :: this_module_long = 'LightKrylov_TestUtils' integer, parameter, public :: test_size = 128 diff --git a/src/TestUtils.fypp b/src/TestUtils.fypp index 056e921b..61f9f856 100644 --- a/src/TestUtils.fypp +++ b/src/TestUtils.fypp @@ -13,8 +13,8 @@ module LightKrylov_TestUtils private - character(len=*), parameter, private :: this_module = 'LK_TUtils' - character(len=*), parameter, private :: this_module_long = 'LightKrylov_TestUtils' + character(len=*), parameter :: this_module = 'LK_TUtils' + character(len=*), parameter :: this_module_long = 'LightKrylov_TestUtils' integer, parameter, public :: test_size = 128 diff --git a/src/Timer.f90 b/src/Timer.f90 new file mode 100644 index 00000000..2035b140 --- /dev/null +++ b/src/Timer.f90 @@ -0,0 +1,690 @@ +module LightKrylov_Timing + use stdlib_optval, only: optval + use stdlib_ascii, only: to_lower + use LightKrylov_Constants, only: dp + use LightKrylov_Logger + implicit none + private + character(len=*), parameter :: this_module = 'LK_Timer' + character(len=*), parameter :: this_module_long = 'LightKrylov_Timer' + logical :: if_time = .false. + + public :: time_lightkrylov + public :: global_lightkrylov_timer + + ! Timer type + type, public :: lightkrylov_timer + private + character(len=128), public :: name = 'default_timer' + real(dp) :: elapsed_time = 0.0_dp + real(dp) :: start_time = 0.0_dp + real(dp), dimension(:), allocatable :: etime_history + real(dp), dimension(:), allocatable :: etavg_history + integer, dimension(:), allocatable :: count_history + logical :: running = .false. + integer :: count = 0 + integer :: reset_counter = 0 + contains + private + procedure, pass(self), public :: start => start_timer + procedure, pass(self), public :: stop => stop_timer + procedure, pass(self), public :: pause => pause_timer + procedure, pass(self), public :: reset => reset_timer + procedure, pass(self), public :: finalize => finalize_timer + procedure, pass(self), public :: get_time => get_timer_time + procedure, pass(self), public :: print_info => print_timer_info + procedure, pass(self), public :: save_timer_history + end type lightkrylov_timer + + ! Abstract watch type + type, abstract, public :: abstract_watch + !! Base type to define a global timer. + private + type(lightkrylov_timer), dimension(:), allocatable :: timers + integer :: timer_count = 0 + integer :: private_count = 0 + logical :: user_mode = .false. + integer :: user_count = 0 + logical :: is_initialized + contains + private + procedure, pass(self), public :: add_timer + procedure, pass(self), public :: remove_timer + procedure, pass(self), public :: get_timer_id + procedure, pass(self), public :: enumerate + procedure, pass(self), public :: reset_all + procedure, pass(self), public :: start => start_timer_by_name + procedure, pass(self), public :: stop => stop_timer_by_name + procedure, pass(self), public :: pause => pause_timer_by_name + procedure, pass(self), public :: reset => reset_timer_by_name + procedure(abstract_watch_init), pass(self), deferred, public :: initialize + procedure(abstract_watch_exit), pass(self), deferred, public :: finalize + end type abstract_watch + + abstract interface + subroutine abstract_watch_init(self) + !! Interface for the initialization of the structure. + import abstract_watch + class(abstract_watch), intent(inout) :: self + end subroutine abstract_watch_init + subroutine abstract_watch_exit(self) + !! Interface for the finalization of the structure including the printing of the results + import abstract_watch + class(abstract_watch), intent(inout) :: self + end subroutine abstract_watch_exit + end interface + + ! LightKrylov_watch type + type, extends(abstract_watch), public :: lightkrylov_watch + !! Global timing structure to contain all timers within Lightkrylov + character(len=128) :: name = 'lightkrylov_timer' + integer :: basekrylov_count = 0 + integer :: iterativesolvers_count = 0 + integer :: newtonkrylov_count = 0 + contains + private + procedure, pass(self), public :: initialize => initialize_lightkrylov_watch + procedure, pass(self), public :: finalize => finalize_lightkrylov_watch + end type lightkrylov_watch + + type(lightkrylov_watch) :: global_lightkrylov_timer +contains + + logical function time_lightkrylov() result(if_time_lightkrylov) + if_time_lightkrylov = if_time + end function time_lightkrylov + + !-------------------------------------------------------------- + ! Type-bound procedures for lightkrylov_timer type + !-------------------------------------------------------------- + + subroutine start_timer(self) + class(lightkrylov_timer), intent(inout) :: self + if (.not. self%running) then + call cpu_time(self%start_time) + self%running = .true. + self%count = self%count + 1 + end if + end subroutine start_timer + + subroutine stop_timer(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + real(dp) :: t_now + call cpu_time(t_now) + if (self%running) then + self%elapsed_time = self%elapsed_time + (t_now - self%start_time) + self%running = .false. + end if + end subroutine stop_timer + + subroutine pause_timer(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + real(dp) :: t_now + call cpu_time(t_now) + if (self%running) then + self%elapsed_time = self%elapsed_time + (t_now - self%start_time) + self%running = .false. + end if + end subroutine pause_timer + + subroutine save_timer_history(self) + class(lightkrylov_timer), intent(inout) :: self + if (self%reset_counter == 0) then + allocate(self%etime_history(1)) + allocate(self%etavg_history(1)) + allocate(self%count_history(1)) + if (self%count > 0) then + self%etime_history(1) = self%elapsed_time + self%etavg_history(1) = self%elapsed_time/self%count + self%count_history(1) = self%count + else + self%etime_history(1) = 0.0_dp + self%etavg_history(1) = 0.0_dp + self%count_history(1) = self%count + end if + self%reset_counter = 1 + else + if (self%count > 0) then + self%etime_history = [ self%etime_history, self%elapsed_time ] + self%etavg_history = [ self%etavg_history, self%elapsed_time/self%count ] + self%count_history = [ self%count_history, self%count ] + else + self%etime_history(1) = 0.0_dp + self%etavg_history(1) = 0.0_dp + self%count_history(1) = self%count + end if + self%reset_counter = self%reset_counter + 1 + end if + end subroutine save_timer_history + + subroutine reset_timer(self, save_history) + class(lightkrylov_timer), intent(inout) :: self + logical, optional, intent(in) :: save_history + ! internal + logical :: ifsave + ifsave = optval(save_history, .true.) + if (ifsave) then + ! soft reset, only if data was collected + if (self%count > 0) then + call self%save_timer_history() + self%elapsed_time = 0.0_dp + self%start_time = 0.0_dp + self%running = .false. + self%count = 0 + end if + else + ! hard reset + self%elapsed_time = 0.0_dp + self%start_time = 0.0_dp + self%running = .false. + self%count = 0 + self%reset_counter = 0 + deallocate(self%etime_history) + deallocate(self%etavg_history) + deallocate(self%count_history) + end if + end subroutine reset_timer + + real(dp) function get_timer_time(self) result(etime) + class(lightkrylov_timer), intent(inout) :: self + if (self%running) then + call self%stop() + end if + etime = self%elapsed_time + end function + + subroutine print_timer_info(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + integer :: i + real(dp) :: etime, etavg + character(len=128) :: msg, timer_fmt + timer_fmt = '(2X,A30," : ",I7,2(1X,F12.6))' + call logger%log_message('### Timer info #######################################', & + & module=this_module) + write(msg, '(A32," : ",A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + etime = 0.0_dp + etavg = 0.0_dp + etime = self%get_time() + if (self%count > 0) etavg = etime/self%count + write(msg,timer_fmt) trim(self%name), self%count, etime, etavg + call logger%log_message(msg, module=this_module) + call logger%log_message('### Timer info #######################################', & + & module=this_module) + end subroutine print_timer_info + + subroutine finalize_timer(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + integer :: i + integer :: ic_bk, ic_is, ic_nk, ic_user, count + real(dp) :: etime, etavg + character(len=128) :: msg, timer_fmt, timer_fmt_reset + timer_fmt = '(2X,A30," : ",A6,1X,I7,2(1X,F12.6))' + timer_fmt_reset = '(2X,33X,A6,I3,1X,I7,2(1X,F12.6))' + call logger%log_message('### Timer summary #######################################', & + & module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + etavg = 0.0_dp + if (self%count > 0 .or. self%reset_counter > 0) then + if (self%reset_counter == 0) call self%save_timer_history() + etime = sum(self%etime_history) + count = sum(self%count_history) + etavg = sum(self%etavg_history)/self%reset_counter + write(msg,timer_fmt) trim(self%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (self%reset_counter > 1) then + do i = 1, self%reset_counter + etime = self%etime_history(i) + etavg = self%etavg_history(i) + count = self%count_history(i) + write(msg,timer_fmt_reset) 'reset', i, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + call logger%log_message('### Timer summary #######################################', & + & module=this_module) + end subroutine finalize_timer + + !-------------------------------------------------------------- + ! Type-bound procedures for abstract_watch type + !-------------------------------------------------------------- + + integer function get_timer_id(self, name) result(id) + class(abstract_watch) :: self + character(len=*) :: name + ! internal + integer :: i + id = 0 + do i = 1, self%timer_count + if (self%timers(i)%name == to_lower(name)) then + id = i + end if + end do + end function get_timer_id + + subroutine add_timer(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + if (self%timer_count == 0) then + allocate(self%timers(1)) + self%timers(1) = lightkrylov_timer(to_lower(name)) + self%timer_count = 1 + else + if (self%get_timer_id(name) > 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" already defined!', & + & module=this_module, procedure='add_timer') + end if + self%timers = [ self%timers, lightkrylov_timer(name) ] + self%timer_count = self%timer_count + 1 + if (self%user_mode) self%user_count = self%user_count + 1 + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" added.', module=this_module) + end subroutine add_timer + + subroutine remove_timer(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + type(lightkrylov_timer), dimension(:), allocatable :: new_timers + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not defined!', & + & module=this_module, procedure='remove_timer') + else + if (id <= self%private_count) then + call logger%log_message('Cannot remove private timer "'//to_lower(trim(name))//'".', & + & module=this_module, procedure='remove_timer') + else + self%timer_count = self%timer_count - 1 + allocate(new_timers(self%timer_count)) + new_timers(1:id-1) = self%timers(1:id-1) + new_timers(id:) = self%timers(id+1:) + deallocate(self%timers) + self%timers = new_timers + end if + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" removed.', module=this_module) + end subroutine remove_timer + + subroutine start_timer_by_name(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%start() + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" started.', module=this_module) + end subroutine start_timer_by_name + + subroutine stop_timer_by_name(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%stop() + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" stopped.', module=this_module) + end subroutine stop_timer_by_name + + subroutine pause_timer_by_name(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%pause() + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" paused.', module=this_module) + end subroutine + + subroutine reset_timer_by_name(self, name, save_history) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + logical, optional, intent(in) :: save_history + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%reset(save_history) + end if + end subroutine + + subroutine enumerate(self, only_user) + class(abstract_watch), intent(in) :: self + logical, optional, intent(in) :: only_user + ! internal + integer :: i + logical :: only_user_ + character(len=128) :: msg + only_user_ = optval(only_user, .true.) + if (.not. only_user_) then + call logger%log_message('Registered timers: all', module=this_module) + do i = 1, self%private_count + write(msg,'(4X,I4,A,A)') i, ' : ', trim(self%timers(i)%name) + call logger%log_message(msg, module=this_module) + end do + end if + if (self%user_count > 0) then + call logger%log_message('Registered timers: user', module=this_module) + do i = self%private_count+1, self%timer_count + write(msg,'(4X,I4,A,A)') i, ' : ', trim(self%timers(i)%name) + call logger%log_message(msg, module=this_module) + end do + end if + end subroutine enumerate + + subroutine reset_all(self, save_history) + class(abstract_watch), intent(inout) :: self + logical, optional, intent(in) :: save_history + ! internal + integer :: i + character(len=128) :: msg + do i = 1, self%timer_count + call self%timers(i)%reset(save_history) + end do + end subroutine reset_all + + !-------------------------------------------------------------- + ! Concrete implementations for the lightkrylov_watch type + !-------------------------------------------------------------- + + subroutine initialize_lightkrylov_watch(self) + class(lightkrylov_watch), intent(inout) :: self + ! internal + character(len=128) :: msg + if (.not. self%is_initialized) then + ! timers for LightKrylov_BaseKrylov + ! rsp + call self%add_timer('qr_with_pivoting_rsp') + call self%add_timer('qr_no_pivoting_rsp') + call self%add_timer('orthonormalize_basis_rsp') + call self%add_timer('orthonormalize_vector_against_basis_rsp') + call self%add_timer('orthonormalize_basis_against_basis_rsp') + call self%add_timer('dgs_vector_against_basis_rsp') + call self%add_timer('dgs_basis_against_basis_rsp') + call self%add_timer('arnoldi_rsp') + call self%add_timer('lanczos_bidiagonalization_rsp') + call self%add_timer('lanczos_tridiagonalization_rsp') + self%basekrylov_count = self%timer_count + ! rdp + call self%add_timer('qr_with_pivoting_rdp') + call self%add_timer('qr_no_pivoting_rdp') + call self%add_timer('orthonormalize_basis_rdp') + call self%add_timer('orthonormalize_vector_against_basis_rdp') + call self%add_timer('orthonormalize_basis_against_basis_rdp') + call self%add_timer('dgs_vector_against_basis_rdp') + call self%add_timer('dgs_basis_against_basis_rdp') + call self%add_timer('arnoldi_rdp') + call self%add_timer('lanczos_bidiagonalization_rdp') + call self%add_timer('lanczos_tridiagonalization_rdp') + self%basekrylov_count = self%timer_count + ! csp + call self%add_timer('qr_with_pivoting_csp') + call self%add_timer('qr_no_pivoting_csp') + call self%add_timer('orthonormalize_basis_csp') + call self%add_timer('orthonormalize_vector_against_basis_csp') + call self%add_timer('orthonormalize_basis_against_basis_csp') + call self%add_timer('dgs_vector_against_basis_csp') + call self%add_timer('dgs_basis_against_basis_csp') + call self%add_timer('arnoldi_csp') + call self%add_timer('lanczos_bidiagonalization_csp') + call self%add_timer('lanczos_tridiagonalization_csp') + self%basekrylov_count = self%timer_count + ! cdp + call self%add_timer('qr_with_pivoting_cdp') + call self%add_timer('qr_no_pivoting_cdp') + call self%add_timer('orthonormalize_basis_cdp') + call self%add_timer('orthonormalize_vector_against_basis_cdp') + call self%add_timer('orthonormalize_basis_against_basis_cdp') + call self%add_timer('dgs_vector_against_basis_cdp') + call self%add_timer('dgs_basis_against_basis_cdp') + call self%add_timer('arnoldi_cdp') + call self%add_timer('lanczos_bidiagonalization_cdp') + call self%add_timer('lanczos_tridiagonalization_cdp') + self%basekrylov_count = self%timer_count + ! timers for LightKrylov_IterativeSolvers + ! rsp + call self%add_timer('eigs_rsp') + call self%add_timer('eighs_rsp') + call self%add_timer('svds_rsp') + call self%add_timer('gmres_rsp') + call self%add_timer('fgmres_rsp') + call self%add_timer('cg_rsp') + self%iterativesolvers_count = self%timer_count + ! rdp + call self%add_timer('eigs_rdp') + call self%add_timer('eighs_rdp') + call self%add_timer('svds_rdp') + call self%add_timer('gmres_rdp') + call self%add_timer('fgmres_rdp') + call self%add_timer('cg_rdp') + self%iterativesolvers_count = self%timer_count + ! csp + call self%add_timer('eigs_csp') + call self%add_timer('eighs_csp') + call self%add_timer('svds_csp') + call self%add_timer('gmres_csp') + call self%add_timer('fgmres_csp') + call self%add_timer('cg_csp') + self%iterativesolvers_count = self%timer_count + ! cdp + call self%add_timer('eigs_cdp') + call self%add_timer('eighs_cdp') + call self%add_timer('svds_cdp') + call self%add_timer('gmres_cdp') + call self%add_timer('fgmres_cdp') + call self%add_timer('cg_cdp') + self%iterativesolvers_count = self%timer_count + ! timers for LightKrylov_NewtonKrylov + ! rsp + call self%add_timer('newton_rsp') + ! rdp + call self%add_timer('newton_rdp') + ! csp + call self%add_timer('newton_csp') + ! cdp + call self%add_timer('newton_cdp') + self%newtonkrylov_count = self%timer_count + self%private_count = self%timer_count + write(msg,'(3X,I4,A)') self%private_count, ' system timers registered.' + call logger%log_information(msg, module=this_module, procedure='timer initialization') + else + call self%reset_all(save_history = .false.) + write(msg,'(3X,I4,A)') self%private_count, ' system timers registered and fully reset.' + call logger%log_information(msg, module=this_module, procedure='timer initialization') + if (self%user_count > 0) then + write(msg,'(3X,I4,A)') self%user_count, ' user defined timers registered and fully reset.' + call logger%log_information(msg, module=this_module, procedure='timer initialization') + end if + end if + self%user_mode = .true. + if_time = .true. + call logger%log_message('LightKrylov system timer initialization complete.', module=this_module) + + end subroutine initialize_lightkrylov_watch + + subroutine finalize_lightkrylov_watch(self) + class(lightkrylov_watch), intent(inout) :: self + ! internal + integer :: i, j, icalled + integer :: ic_bk, ic_is, ic_nk, ic_user, count, rcount + real(dp) :: etime, etavg + character(len=128) :: msg, timer_fmt, timer_fmt_reset + icalled = 0 + do i = 1, self%timer_count + call self%timers(i)%stop() + if (self%timers(i)%count > 0) icalled = icalled + 1 + call self%timers(i)%save_timer_history() + if (i == self%basekrylov_count) then + ic_bk = icalled + else if (i == self%iterativesolvers_count) then + ic_is = icalled - ic_bk + else if (i == self%newtonkrylov_count) then + ic_nk = icalled - ic_is - ic_bk + end if + end do + ic_user = icalled - ic_nk - ic_is - ic_bk + if_time = .false. + call logger%log_message('LightKrylov timer finalization complete.', module=this_module) + call logger%log_message('### Global timer summary #######################################', & + & module=this_module) + call logger%log_message('____________________', module=this_module) + call logger%log_message('Overview:', module=this_module) + write(msg, '(2X,A40,I5)') 'Total active timers:', self%timer_count + call logger%log_message(msg, module=this_module) + write(msg, '(2X,A40,I5)') 'User defined:', self%user_count + call logger%log_message(msg, module=this_module) + write(msg, '(2X,A40,I5)') 'Called timers:', icalled + call logger%log_message(msg, module=this_module) + timer_fmt = '(2X,A30," : ",A6,1X,I7,2(1X,F12.6))' + timer_fmt_reset = '(2X,33X,A6,I3,1X,I7,2(1X,F12.6))' + if (ic_bk > 0) then + call logger%log_message('____________________', module=this_module) + call logger%log_message('BaseKrylov:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = 1, self%basekrylov_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + j = self%basekrylov_count + if (ic_is > 0) then + call logger%log_message('____________________', module=this_module) + call logger%log_message('IterativeSolvers:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = j, self%iterativesolvers_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + j = self%iterativesolvers_count + if (ic_nk > 0) then + call logger%log_message('____________________', module=this_module) + call logger%log_message('NewtonKrylov:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = j, self%newtonkrylov_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + if (self%user_count > 0 .and. ic_user > 0) then + j = self%private_count + call logger%log_message('____________________', module=this_module) + call logger%log_message('User-defined:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = j, self%timer_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + call logger%log_message('### Global timer summary #######################################', & + & module=this_module) + end subroutine finalize_lightkrylov_watch + +end module LightKrylov_Timing \ No newline at end of file diff --git a/src/Timer.fypp b/src/Timer.fypp new file mode 100644 index 00000000..3f88efda --- /dev/null +++ b/src/Timer.fypp @@ -0,0 +1,632 @@ +#:include "../include/common.fypp" +#:set RC_KINDS_TYPES = REAL_KINDS_TYPES + CMPLX_KINDS_TYPES +module LightKrylov_Timing + use stdlib_optval, only: optval + use stdlib_ascii, only: to_lower + use LightKrylov_Constants, only: dp + use LightKrylov_Logger + implicit none + private + character(len=*), parameter :: this_module = 'LK_Timer' + character(len=*), parameter :: this_module_long = 'LightKrylov_Timer' + logical :: if_time = .false. + + public :: time_lightkrylov + public :: global_lightkrylov_timer + + ! Timer type + type, public :: lightkrylov_timer + private + character(len=128), public :: name = 'default_timer' + real(dp) :: elapsed_time = 0.0_dp + real(dp) :: start_time = 0.0_dp + real(dp), dimension(:), allocatable :: etime_history + real(dp), dimension(:), allocatable :: etavg_history + integer, dimension(:), allocatable :: count_history + logical :: running = .false. + integer :: count = 0 + integer :: reset_counter = 0 + contains + private + procedure, pass(self), public :: start => start_timer + procedure, pass(self), public :: stop => stop_timer + procedure, pass(self), public :: pause => pause_timer + procedure, pass(self), public :: reset => reset_timer + procedure, pass(self), public :: finalize => finalize_timer + procedure, pass(self), public :: get_time => get_timer_time + procedure, pass(self), public :: print_info => print_timer_info + procedure, pass(self), public :: save_timer_history + end type lightkrylov_timer + + ! Abstract watch type + type, abstract, public :: abstract_watch + !! Base type to define a global timer. + private + type(lightkrylov_timer), dimension(:), allocatable :: timers + integer :: timer_count = 0 + integer :: private_count = 0 + logical :: user_mode = .false. + integer :: user_count = 0 + logical :: is_initialized + contains + private + procedure, pass(self), public :: add_timer + procedure, pass(self), public :: remove_timer + procedure, pass(self), public :: get_timer_id + procedure, pass(self), public :: enumerate + procedure, pass(self), public :: reset_all + procedure, pass(self), public :: start => start_timer_by_name + procedure, pass(self), public :: stop => stop_timer_by_name + procedure, pass(self), public :: pause => pause_timer_by_name + procedure, pass(self), public :: reset => reset_timer_by_name + procedure(abstract_watch_init), pass(self), deferred, public :: initialize + procedure(abstract_watch_exit), pass(self), deferred, public :: finalize + end type abstract_watch + + abstract interface + subroutine abstract_watch_init(self) + !! Interface for the initialization of the structure. + import abstract_watch + class(abstract_watch), intent(inout) :: self + end subroutine abstract_watch_init + subroutine abstract_watch_exit(self) + !! Interface for the finalization of the structure including the printing of the results + import abstract_watch + class(abstract_watch), intent(inout) :: self + end subroutine abstract_watch_exit + end interface + + ! LightKrylov_watch type + type, extends(abstract_watch), public :: lightkrylov_watch + !! Global timing structure to contain all timers within Lightkrylov + character(len=128) :: name = 'lightkrylov_timer' + integer :: basekrylov_count = 0 + integer :: iterativesolvers_count = 0 + integer :: newtonkrylov_count = 0 + contains + private + procedure, pass(self), public :: initialize => initialize_lightkrylov_watch + procedure, pass(self), public :: finalize => finalize_lightkrylov_watch + end type lightkrylov_watch + + type(lightkrylov_watch) :: global_lightkrylov_timer +contains + + logical function time_lightkrylov() result(if_time_lightkrylov) + if_time_lightkrylov = if_time + end function time_lightkrylov + + !-------------------------------------------------------------- + ! Type-bound procedures for lightkrylov_timer type + !-------------------------------------------------------------- + + subroutine start_timer(self) + class(lightkrylov_timer), intent(inout) :: self + if (.not. self%running) then + call cpu_time(self%start_time) + self%running = .true. + self%count = self%count + 1 + end if + end subroutine start_timer + + subroutine stop_timer(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + real(dp) :: t_now + call cpu_time(t_now) + if (self%running) then + self%elapsed_time = self%elapsed_time + (t_now - self%start_time) + self%running = .false. + end if + end subroutine stop_timer + + subroutine pause_timer(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + real(dp) :: t_now + call cpu_time(t_now) + if (self%running) then + self%elapsed_time = self%elapsed_time + (t_now - self%start_time) + self%running = .false. + end if + end subroutine pause_timer + + subroutine save_timer_history(self) + class(lightkrylov_timer), intent(inout) :: self + if (self%reset_counter == 0) then + allocate(self%etime_history(1)) + allocate(self%etavg_history(1)) + allocate(self%count_history(1)) + if (self%count > 0) then + self%etime_history(1) = self%elapsed_time + self%etavg_history(1) = self%elapsed_time/self%count + self%count_history(1) = self%count + else + self%etime_history(1) = 0.0_dp + self%etavg_history(1) = 0.0_dp + self%count_history(1) = self%count + end if + self%reset_counter = 1 + else + if (self%count > 0) then + self%etime_history = [ self%etime_history, self%elapsed_time ] + self%etavg_history = [ self%etavg_history, self%elapsed_time/self%count ] + self%count_history = [ self%count_history, self%count ] + else + self%etime_history(1) = 0.0_dp + self%etavg_history(1) = 0.0_dp + self%count_history(1) = self%count + end if + self%reset_counter = self%reset_counter + 1 + end if + end subroutine save_timer_history + + subroutine reset_timer(self, save_history) + class(lightkrylov_timer), intent(inout) :: self + logical, optional, intent(in) :: save_history + ! internal + logical :: ifsave + ifsave = optval(save_history, .true.) + if (ifsave) then + ! soft reset, only if data was collected + if (self%count > 0) then + call self%save_timer_history() + self%elapsed_time = 0.0_dp + self%start_time = 0.0_dp + self%running = .false. + self%count = 0 + end if + else + ! hard reset + self%elapsed_time = 0.0_dp + self%start_time = 0.0_dp + self%running = .false. + self%count = 0 + self%reset_counter = 0 + deallocate(self%etime_history) + deallocate(self%etavg_history) + deallocate(self%count_history) + end if + end subroutine reset_timer + + real(dp) function get_timer_time(self) result(etime) + class(lightkrylov_timer), intent(inout) :: self + if (self%running) then + call self%stop() + end if + etime = self%elapsed_time + end function + + subroutine print_timer_info(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + integer :: i + real(dp) :: etime, etavg + character(len=128) :: msg, timer_fmt + timer_fmt = '(2X,A30," : ",I7,2(1X,F12.6))' + call logger%log_message('### Timer info #######################################', & + & module=this_module) + write(msg, '(A32," : ",A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + etime = 0.0_dp + etavg = 0.0_dp + etime = self%get_time() + if (self%count > 0) etavg = etime/self%count + write(msg,timer_fmt) trim(self%name), self%count, etime, etavg + call logger%log_message(msg, module=this_module) + call logger%log_message('### Timer info #######################################', & + & module=this_module) + end subroutine print_timer_info + + subroutine finalize_timer(self) + class(lightkrylov_timer), intent(inout) :: self + ! internal + integer :: i + integer :: ic_bk, ic_is, ic_nk, ic_user, count + real(dp) :: etime, etavg + character(len=128) :: msg, timer_fmt, timer_fmt_reset + timer_fmt = '(2X,A30," : ",A6,1X,I7,2(1X,F12.6))' + timer_fmt_reset = '(2X,33X,A6,I3,1X,I7,2(1X,F12.6))' + call logger%log_message('### Timer summary #######################################', & + & module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + etavg = 0.0_dp + if (self%count > 0 .or. self%reset_counter > 0) then + if (self%reset_counter == 0) call self%save_timer_history() + etime = sum(self%etime_history) + count = sum(self%count_history) + etavg = sum(self%etavg_history)/self%reset_counter + write(msg,timer_fmt) trim(self%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (self%reset_counter > 1) then + do i = 1, self%reset_counter + etime = self%etime_history(i) + etavg = self%etavg_history(i) + count = self%count_history(i) + write(msg,timer_fmt_reset) 'reset', i, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + call logger%log_message('### Timer summary #######################################', & + & module=this_module) + end subroutine finalize_timer + + !-------------------------------------------------------------- + ! Type-bound procedures for abstract_watch type + !-------------------------------------------------------------- + + integer function get_timer_id(self, name) result(id) + class(abstract_watch) :: self + character(len=*) :: name + ! internal + integer :: i + id = 0 + do i = 1, self%timer_count + if (self%timers(i)%name == to_lower(name)) then + id = i + end if + end do + end function get_timer_id + + subroutine add_timer(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + if (self%timer_count == 0) then + allocate(self%timers(1)) + self%timers(1) = lightkrylov_timer(to_lower(name)) + self%timer_count = 1 + else + if (self%get_timer_id(name) > 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" already defined!', & + & module=this_module, procedure='add_timer') + end if + self%timers = [ self%timers, lightkrylov_timer(name) ] + self%timer_count = self%timer_count + 1 + if (self%user_mode) self%user_count = self%user_count + 1 + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" added.', module=this_module) + end subroutine add_timer + + subroutine remove_timer(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + type(lightkrylov_timer), dimension(:), allocatable :: new_timers + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not defined!', & + & module=this_module, procedure='remove_timer') + else + if (id <= self%private_count) then + call logger%log_message('Cannot remove private timer "'//to_lower(trim(name))//'".', & + & module=this_module, procedure='remove_timer') + else + self%timer_count = self%timer_count - 1 + allocate(new_timers(self%timer_count)) + new_timers(1:id-1) = self%timers(1:id-1) + new_timers(id:) = self%timers(id+1:) + deallocate(self%timers) + self%timers = new_timers + end if + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" removed.', module=this_module) + end subroutine remove_timer + + subroutine start_timer_by_name(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%start() + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" started.', module=this_module) + end subroutine start_timer_by_name + + subroutine stop_timer_by_name(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%stop() + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" stopped.', module=this_module) + end subroutine stop_timer_by_name + + subroutine pause_timer_by_name(self, name) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%pause() + end if + call logger%log_debug('Timer "'//to_lower(trim(name))//'" paused.', module=this_module) + end subroutine + + subroutine reset_timer_by_name(self, name, save_history) + class(abstract_watch), intent(inout) :: self + character(len=*), intent(in) :: name + logical, optional, intent(in) :: save_history + ! internal + integer :: id + id = self%get_timer_id(name) + if (id == 0) then + call stop_error('Timer "'//to_lower(trim(name))//'" not found!', & + & module=this_module, procedure='start_timer_by_name') + else + call self%timers(id)%reset(save_history) + end if + end subroutine + + subroutine enumerate(self, only_user) + class(abstract_watch), intent(in) :: self + logical, optional, intent(in) :: only_user + ! internal + integer :: i + logical :: only_user_ + character(len=128) :: msg + only_user_ = optval(only_user, .true.) + if (.not. only_user_) then + call logger%log_message('Registered timers: all', module=this_module) + do i = 1, self%private_count + write(msg,'(4X,I4,A,A)') i, ' : ', trim(self%timers(i)%name) + call logger%log_message(msg, module=this_module) + end do + end if + if (self%user_count > 0) then + call logger%log_message('Registered timers: user', module=this_module) + do i = self%private_count+1, self%timer_count + write(msg,'(4X,I4,A,A)') i, ' : ', trim(self%timers(i)%name) + call logger%log_message(msg, module=this_module) + end do + end if + end subroutine enumerate + + subroutine reset_all(self, save_history) + class(abstract_watch), intent(inout) :: self + logical, optional, intent(in) :: save_history + ! internal + integer :: i + character(len=128) :: msg + do i = 1, self%timer_count + call self%timers(i)%reset(save_history) + end do + end subroutine reset_all + + !-------------------------------------------------------------- + ! Concrete implementations for the lightkrylov_watch type + !-------------------------------------------------------------- + + subroutine initialize_lightkrylov_watch(self) + class(lightkrylov_watch), intent(inout) :: self + ! internal + character(len=128) :: msg + if (.not. self%is_initialized) then + ! timers for LightKrylov_BaseKrylov + #:for kind, type in RC_KINDS_TYPES + ! ${type[0]}$${kind}$ + call self%add_timer('qr_with_pivoting_${type[0]}$${kind}$') + call self%add_timer('qr_no_pivoting_${type[0]}$${kind}$') + call self%add_timer('orthonormalize_basis_${type[0]}$${kind}$') + call self%add_timer('orthonormalize_vector_against_basis_${type[0]}$${kind}$') + call self%add_timer('orthonormalize_basis_against_basis_${type[0]}$${kind}$') + call self%add_timer('dgs_vector_against_basis_${type[0]}$${kind}$') + call self%add_timer('dgs_basis_against_basis_${type[0]}$${kind}$') + call self%add_timer('arnoldi_${type[0]}$${kind}$') + call self%add_timer('lanczos_bidiagonalization_${type[0]}$${kind}$') + call self%add_timer('lanczos_tridiagonalization_${type[0]}$${kind}$') + self%basekrylov_count = self%timer_count + #:endfor + ! timers for LightKrylov_IterativeSolvers + #:for kind, type in RC_KINDS_TYPES + ! ${type[0]}$${kind}$ + call self%add_timer('eigs_${type[0]}$${kind}$') + call self%add_timer('eighs_${type[0]}$${kind}$') + call self%add_timer('svds_${type[0]}$${kind}$') + call self%add_timer('gmres_${type[0]}$${kind}$') + call self%add_timer('fgmres_${type[0]}$${kind}$') + call self%add_timer('cg_${type[0]}$${kind}$') + self%iterativesolvers_count = self%timer_count + #:endfor + ! timers for LightKrylov_NewtonKrylov + #:for kind, type in RC_KINDS_TYPES + ! ${type[0]}$${kind}$ + call self%add_timer('newton_${type[0]}$${kind}$') + #:endfor + self%newtonkrylov_count = self%timer_count + self%private_count = self%timer_count + write(msg,'(3X,I4,A)') self%private_count, ' system timers registered.' + call logger%log_information(msg, module=this_module, procedure='timer initialization') + else + call self%reset_all(save_history = .false.) + write(msg,'(3X,I4,A)') self%private_count, ' system timers registered and fully reset.' + call logger%log_information(msg, module=this_module, procedure='timer initialization') + if (self%user_count > 0) then + write(msg,'(3X,I4,A)') self%user_count, ' user defined timers registered and fully reset.' + call logger%log_information(msg, module=this_module, procedure='timer initialization') + end if + end if + self%user_mode = .true. + if_time = .true. + call logger%log_message('LightKrylov system timer initialization complete.', module=this_module) + + end subroutine initialize_lightkrylov_watch + + subroutine finalize_lightkrylov_watch(self) + class(lightkrylov_watch), intent(inout) :: self + ! internal + integer :: i, j, icalled + integer :: ic_bk, ic_is, ic_nk, ic_user, count, rcount + real(dp) :: etime, etavg + character(len=128) :: msg, timer_fmt, timer_fmt_reset + icalled = 0 + do i = 1, self%timer_count + call self%timers(i)%stop() + if (self%timers(i)%count > 0) icalled = icalled + 1 + call self%timers(i)%save_timer_history() + if (i == self%basekrylov_count) then + ic_bk = icalled + else if (i == self%iterativesolvers_count) then + ic_is = icalled - ic_bk + else if (i == self%newtonkrylov_count) then + ic_nk = icalled - ic_is - ic_bk + end if + end do + ic_user = icalled - ic_nk - ic_is - ic_bk + if_time = .false. + call logger%log_message('LightKrylov timer finalization complete.', module=this_module) + call logger%log_message('### Global timer summary #######################################', & + & module=this_module) + call logger%log_message('____________________', module=this_module) + call logger%log_message('Overview:', module=this_module) + write(msg, '(2X,A40,I5)') 'Total active timers:', self%timer_count + call logger%log_message(msg, module=this_module) + write(msg, '(2X,A40,I5)') 'User defined:', self%user_count + call logger%log_message(msg, module=this_module) + write(msg, '(2X,A40,I5)') 'Called timers:', icalled + call logger%log_message(msg, module=this_module) + timer_fmt = '(2X,A30," : ",A6,1X,I7,2(1X,F12.6))' + timer_fmt_reset = '(2X,33X,A6,I3,1X,I7,2(1X,F12.6))' + if (ic_bk > 0) then + call logger%log_message('____________________', module=this_module) + call logger%log_message('BaseKrylov:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = 1, self%basekrylov_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + j = self%basekrylov_count + if (ic_is > 0) then + call logger%log_message('____________________', module=this_module) + call logger%log_message('IterativeSolvers:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = j, self%iterativesolvers_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + j = self%iterativesolvers_count + if (ic_nk > 0) then + call logger%log_message('____________________', module=this_module) + call logger%log_message('NewtonKrylov:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = j, self%newtonkrylov_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + if (self%user_count > 0 .and. ic_user > 0) then + j = self%private_count + call logger%log_message('____________________', module=this_module) + call logger%log_message('User-defined:', module=this_module) + write(msg, '(A32," : ",7X,A7,2(1X,A12))') 'name', 'calls', 'total (s)', 'avg (s)' + call logger%log_message(msg, module=this_module) + call logger%log_message('______________________________________________________________________________', & + & module=this_module) + do i = j, self%timer_count + associate(t => self%timers(i)) + rcount = t%reset_counter + if (t%count_history(rcount) > 0) then + etime = sum(t%etime_history) + etavg = sum(t%etavg_history)/rcount + count = sum(t%count_history) + write(msg,timer_fmt) trim(t%name), 'total', count, etime, etavg + call logger%log_message(msg, module=this_module) + if (rcount > 1) then + do j = 1, rcount + etime = t%etime_history(j) + etavg = t%etavg_history(j) + count = t%count_history(j) + write(msg,timer_fmt_reset) 'reset', j, count, etime, etavg + call logger%log_message(msg, module=this_module) + end do + end if + end if + end associate + end do + end if + call logger%log_message('### Global timer summary #######################################', & + & module=this_module) + end subroutine finalize_lightkrylov_watch + +end module LightKrylov_Timing \ No newline at end of file