! ! MiMiC: A Framework for Multiscale Modeling in Computational Chemistry ! Copyright (C) 2015-2022 The MiMiC Contributors (see CONTRIBUTORS file for details). ! ! This file is part of MiMiC. ! ! MiMiC is free software: you can redistribute it and/or modify ! it under the terms of the GNU Lesser General Public License as ! published by the Free Software Foundation, either version 3 of ! the License, or (at your option) any later version. ! ! MiMiC is distributed in the hope that it will be useful, but ! WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU Lesser General Public License for more details. ! ! You should have received a copy of the GNU Lesser General Public License ! along with this program. If not, see <http://www.gnu.org/licenses/>. ! module mimic_utils use, intrinsic :: iso_fortran_env, only : stdout=>output_unit #if defined USE_OPENMP use omp_lib, only: omp_get_wtime #endif use mimic_config, only: PROJECT_VER use mimic_precision, only: dp implicit none character(len=*), dimension(2), parameter :: CITE_PAPERS = & [& "J. Chem. Theory Comput. 2019, 15, 6, 3810–3823 ", & "J. Chem. Theory Comput. 2019, 15, 10, 5601–5613" & ] !> Class representing the call stack entry type :: mimic_stack_entry private !> Name of the entry (procedure) character(len=:), allocatable :: name !> Nested entries (internal calls) type(mimic_stack_entry), dimension(:), pointer :: children => null() !> Pointer to the parent entry type(mimic_stack_entry), pointer :: parent => null() !> Number of nested entries integer :: num_children = 0 !> Array of times of start of the procedure real(dp), dimension(:), allocatable :: start_times !> Array of times of finish of the procedure real(dp), dimension(:), allocatable :: end_times !> Total number of calls integer :: num_calls !> Hash identifier integer :: hash contains procedure :: increment => increment_entry procedure :: print => print_entry end type mimic_stack_entry !> Timer class storing all function calls type :: mimic_timer private !> List of top-level function calls type(mimic_stack_entry), dimension(:), pointer :: entries !> Number of entries integer :: num_entries = 0 contains private procedure :: start => start_timer procedure :: stop => stop_timer procedure :: print => print_timings end type mimic_timer interface mimic_stack_entry module procedure init_entry end interface type(mimic_timer), save :: timer type(mimic_stack_entry), pointer, save :: current_entry => null() public :: timer_start public :: timer_stop public :: timer_print contains !> Writes a welcome message to the standard output together with !> the list of papers to cite. subroutine print_welcome integer :: n_cite write(stdout, *) "---------------------------------------------------------------------" write(stdout, *) "MiMiC: a framework for multiscale modeling in computational chemistry" write(stdout, *) write(stdout, *) "Version: ", PROJECT_VER write(stdout, *) !@todo: in the future this will have to be configurable write(stdout, *) "Using QM/MM module of MiMiC" write(stdout, *) write(stdout, *) "Please cite the following papers:" do n_cite = 1, size(CITE_PAPERS) write(stdout, *) CITE_PAPERS(n_cite) end do write(stdout, *) "---------------------------------------------------------------------" end subroutine print_welcome !> Start timing the routine with a given name. This procedure !> will start tracking the execution time of a given function !> in a call stack tree. Subsequent calls to this function will !> create additional entries in the call stack that are going !> to be shown as children of the original routine. subroutine timer_start(name) !> Name of the function to time. character(len=*), intent(in) :: name current_entry => timer%start(current_entry, name) end subroutine timer_start !> Stop timing last routine. This procedure will record the !> finishing time of the routine that was timed the last. !> Moreover, it will move one level up in the call stack hierarchy. subroutine timer_stop() type(mimic_stack_entry), pointer :: temp_parent => null() if (.not. associated(current_entry)) then return endif temp_parent => current_entry%parent call timer%stop(current_entry) current_entry => temp_parent end subroutine timer_stop !> Print the call stack with timing information. subroutine timer_print call timer%print end subroutine timer_print !> Get current time function get_time() result(time) real(dp) :: time #if defined USE_OPENMP time = omp_get_wtime() #else call cpu_time(time) #endif end function get_time !> Calculate a hash of the string pure function hash_str(str) result(hash) character(len=*), intent(in) :: str integer :: hash integer :: i hash = 3586 do i = 1, len(str) hash = (ishft(hash,5) + hash) + ichar(str(i:i)) end do end function hash_str !> Start a timer for a given function function start_timer(this, parent, name) result(res) class(mimic_timer), intent(inout), target :: this !> pointer to parent stack entry type(mimic_stack_entry), pointer, intent(inout) :: parent !> name of the procedure character(len=*), intent(in) :: name !> Pointer to a created stack entry type(mimic_stack_entry), pointer :: res type(mimic_stack_entry), pointer :: temp_parent integer :: hash hash = hash_str(name) if (associated(parent)) then temp_parent => find_entry(this%entries, this%num_entries, parent%hash) if (.not. associated(temp_parent)) then stop "Invalid stack parent - something is not right" end if res => add_call(temp_parent%children, temp_parent%num_children, hash, name, temp_parent) else res => add_call(this%entries, this%num_entries, hash, name, null()) end if end function start_timer !> Stop a timer for a given function (invalidates the pointer) subroutine stop_timer(this, entry) class(mimic_timer), intent(inout), target :: this !> Function timing of which is currently measured type(mimic_stack_entry), pointer, intent(inout) :: entry entry%end_times(entry%num_calls) = get_time() entry => null() end subroutine stop_timer !> Add a function call to registry function add_call(entries, num_entries, hash, name, parent) result(entry) type(mimic_stack_entry), dimension(:), pointer, intent(inout) :: entries integer, intent(inout) :: num_entries integer, intent(in) :: hash character(len=*), intent(in) :: name type(mimic_stack_entry), pointer, intent(in) :: parent type(mimic_stack_entry), pointer :: entry type(mimic_stack_entry), dimension(:), pointer :: temp_entries logical :: found integer :: i, id found = .false. do i = 1, merge(num_entries, 0, (associated(entries) .and. num_entries > 0)) if (entries(i)%hash == hash) then found = .true. call entries(i)%increment id = i exit end if end do if (.not. found) then if (associated(entries) .and. num_entries > 0) then allocate(temp_entries(size(entries))) do i = 1, num_entries call copy_entry(entries(i), temp_entries(i)) end do deallocate(entries) allocate(entries(num_entries + 1)) do i = 1, size(temp_entries) call copy_entry(temp_entries(i), entries(i)) nullify(entries(i)%parent) end do num_entries = num_entries + 1 deallocate(temp_entries) else num_entries = 1 allocate(entries(1)) endif entries(num_entries) = mimic_stack_entry(name, hash, 1, parent) entries(num_entries)%start_times(1) = get_time() id = num_entries end if entry => entries(id) end function !> Print measured timings of function calls subroutine print_timings(this) class(mimic_timer), intent(inout) :: this integer :: i integer :: hierarchy_level = 0 if (associated(this%entries)) then do i = 1, this%num_entries call this%entries(i)%print(hierarchy_level) end do endif end subroutine print_timings !> Initializer of a stack entry function init_entry(name, hash, num_calls, parent) result(entry) !> Name of a function character(len=*), intent(in) :: name !> Hash ID integer, intent(in) :: hash !> Current number of calls integer, intent(in) :: num_calls !> Parent entry type(mimic_stack_entry), pointer :: parent type(mimic_stack_entry) :: entry entry%name = name entry%hash = hash entry%num_calls = num_calls allocate(entry%start_times(num_calls)) allocate(entry%end_times(num_calls)) entry%num_children = 0 entry%parent => parent end function init_entry !> Add new start time to the entry subroutine increment_entry(this) class(mimic_stack_entry), intent(inout) :: this real(dp), dimension(:), allocatable :: temp_times this%num_calls = this%num_calls + 1 if (allocated(this%start_times)) then call move_alloc(this%start_times, temp_times) allocate(this%start_times(this%num_calls)) this%start_times(1:size(temp_times)) = temp_times deallocate(temp_times) call move_alloc(this%end_times, temp_times) allocate(this%end_times(this%num_calls)) this%end_times(1:size(temp_times)) = temp_times else allocate(this%start_times(1)) allocate(this%end_times(1)) end if this%start_times(this%num_calls) = get_time() end subroutine increment_entry !> Recursive function looking for the entry in array by hash recursive function find_entry(entries, num_entries, hash) result(entry) !> List of entries to search type(mimic_stack_entry), dimension(:), pointer, intent(in) :: entries !> Number of entries integer :: num_entries !> Hash ID of the function integer, intent(in) :: hash !> pointer to a found entry or null pointer type(mimic_stack_entry), pointer :: entry integer :: i, j do i = 1, num_entries if (entries(i)%hash == hash) then entry => entries(i) return endif if (associated(entries(i)%children)) then do j = 1, entries(i)%num_children entry => find_entry(entries(i)%children, entries(i)%num_children, hash) if (associated(entry)) then return end if end do end if end do entry => null() end function find_entry !> Recursive function making a deep copy of stack_entry recursive subroutine copy_entry(src, dst) !> Source entry type(mimic_stack_entry), intent(in) :: src !> Result type(mimic_stack_entry), intent(out), target :: dst integer :: i dst%name = src%name dst%hash = src%hash dst%num_calls = src%num_calls dst%parent => src%parent if (allocated(src%start_times)) then allocate(dst%start_times(size(src%start_times))) allocate(dst%end_times(size(src%end_times))) dst%start_times = src%start_times dst%end_times = src%end_times endif dst%num_children = src%num_children if (associated(src%children) .and. src%num_children > 0) then allocate(dst%children(src%num_children)) do i = 1, src%num_children call copy_entry(src%children(i), dst%children(i)) dst%children(i)%parent => dst end do endif end subroutine copy_entry !> Recursive function printing timing of the entry and its children recursive subroutine print_entry(this, level) class(mimic_stack_entry), intent(inout) :: this integer, intent(in) :: level integer :: i integer :: hierarchy_level character(len=:), allocatable :: shift character(len=95) :: print_str hierarchy_level = level + 1 allocate(character(hierarchy_level + 1) :: shift) shift = "" do i = 1, hierarchy_level shift = shift // "=" end do shift = shift // "> " write(print_str, '(A10,T10,A7,A20,A10,I6,A9,F8.4,A9,F8.4)') shift, "Name:", this%name, & "# calls:", this%num_calls, "Max t.:", maxval(this%end_times - this%start_times), & "Avg. t.:", sum(this%end_times - this%start_times) / this%num_calls print '(A95)', adjustl(print_str) if (associated(this%children)) then do i = 1 , this%num_children call this%children(i)%print(hierarchy_level) end do endif end subroutine print_entry end module mimic_utils