diff --git a/base/modules/Makefile b/base/modules/Makefile index a962b8a1..b6ab52ea 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -38,7 +38,7 @@ UTIL_MODS = auxil/psb_string_mod.o desc/psb_desc_const_mod.o desc/psb_indx_map_m tools/psb_s_tools_a_mod.o tools/psb_d_tools_a_mod.o\ tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o \ tools/psb_tools_mod.o \ - psb_penv_mod.o $(COMMINT) psb_error_impl.o \ + psb_penv_mod.o $(COMMINT) psb_error_impl.o psb_timers_mod.o \ comm/psb_base_linmap_mod.o comm/psb_linmap_mod.o \ comm/psb_s_linmap_mod.o comm/psb_d_linmap_mod.o \ comm/psb_c_linmap_mod.o comm/psb_z_linmap_mod.o \ @@ -237,6 +237,8 @@ serial/psb_vect_mod.o: serial/psb_i_vect_mod.o serial/psb_l_vect_mod.o serial/ps error.o psb_realloc_mod.o: psb_error_mod.o psb_error_impl.o: psb_penv_mod.o +psb_timers_mod.o: psb_penv_mod.o psb_const_mod.o psb_realloc_mod.o psb_error_mod.o + psb_spmat_type.o: auxil/psb_string_mod.o auxil/psb_sort_mod.o desc/psb_desc_mod.o: psb_penv_mod.o psb_realloc_mod.o\ diff --git a/base/modules/psb_base_mod.f90 b/base/modules/psb_base_mod.f90 index 71a95bb7..78a973b6 100644 --- a/base/modules/psb_base_mod.f90 +++ b/base/modules/psb_base_mod.f90 @@ -33,6 +33,7 @@ module psb_base_mod use psb_string_mod use psb_error_mod use psb_penv_mod + use psb_timers_mod use psb_check_mod use psb_sort_mod use psb_desc_mod diff --git a/base/modules/psb_timers_mod.f90 b/base/modules/psb_timers_mod.f90 new file mode 100644 index 00000000..5b2a8054 --- /dev/null +++ b/base/modules/psb_timers_mod.f90 @@ -0,0 +1,337 @@ +! +! Parallel Sparse BLAS version 3.5 +! (C) Copyright 2006-2018 +! Salvatore Filippone +! Alfredo Buttari +! +! Redistribution and use in source and binary forms, with or without +! modification, are permitted provided that the following conditions +! are met: +! 1. Redistributions of source code must retain the above copyright +! notice, this list of conditions and the following disclaimer. +! 2. Redistributions in binary form must reproduce the above copyright +! notice, this list of conditions, and the following disclaimer in the +! documentation and/or other materials provided with the distribution. +! 3. The name of the PSBLAS group or the names of its contributors may +! not be used to endorse or promote products derived from this +! software without specific written permission. +! +! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +! POSSIBILITY OF SUCH DAMAGE. +! +! +! +! Purpose: +! Provide a set of timers +! +! +module psb_timers_mod + use psb_const_mod + use psb_realloc_mod + use psb_error_mod + use psb_penv_mod + + public psb_init_timers, psb_get_timer_idx, psb_reset_timers,& + & psb_tic, psb_toc, psb_print_timers, psb_get_timer + private + + ! Reallocation + integer(psb_ipk_), parameter :: ntchunk = 50 + integer(psb_ipk_), save :: active_timers = 0 + ! Indices + integer(psb_ipk_), parameter :: timer_tic_ = 1, timer_toc_ = 2 + integer(psb_ipk_), parameter :: timer_x_ = 3, timer_sum_ = 4 + integer(psb_ipk_), parameter :: timer_max_ = 5 + integer(psb_ipk_), parameter :: timer_avg_ = 6, timer_min_ = 7 + integer(psb_ipk_), parameter :: timer_entries_ = 7 + + ! The data itself + type psb_string_item + character(len=:), allocatable :: data + end type psb_string_item + integer(psb_ipk_), allocatable :: nsamples(:) + real(psb_dpk_), allocatable :: timers(:,:) + type(psb_string_item), allocatable :: timers_descr(:) + logical :: wanted(timer_entries_) + type(psb_string_item) :: entries_descr(timer_entries_) + save :: nsamples, timers, timers_descr, wanted, entries_descr + + interface psb_realloc + module procedure psb_string_item_realloc + end interface psb_realloc + +contains + + subroutine print_timer(me, timer, timer_descr, iout) + implicit none + integer(psb_ipk_), intent(in) :: me + real(psb_dpk_), intent(in) :: timer(timer_entries_) + type(psb_string_item), intent(in) :: timer_descr + integer(psb_ipk_), optional :: iout + character(len=36) :: tmpname + integer(psb_ipk_) :: iout_, i + if (present(iout)) then + iout_ = iout + else + iout_ = psb_out_unit + end if + + write(tmpname,'(a)') trim(timer_descr%data)//":" + + write(iout_,'(a36,4(1x,a,f10.2))') tmpname,& + & "Sum: ",timer(timer_sum_), & + & "Avg: ",timer(timer_avg_), & + & "Max: ",timer(timer_max_), & + & "Min: ",-timer(timer_min_) + + end subroutine print_timer + + subroutine psb_print_timers(ictxt, idx, proc, global, iout) + implicit none + integer(psb_ipk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in), optional :: idx, proc, iout + logical, optional :: global + ! + ! + ! + integer(psb_ipk_) :: me,np,info,i,j, idxmin_, idxmax_, proc_ + real(psb_dpk_) :: gtimers(timer_entries_) + real(psb_dpk_), allocatable :: ptimers(:,:) + logical :: global_ + + call psb_info(ictxt,me,np) + if (present(global)) then + global_ = global + else + global_ = .true. + end if + if (present(proc)) then + proc_ = proc + else + proc_ = -1 + end if + if (present(idx)) then + idxmin_ = idx + idxmax_ = idx + else + idxmin_ = 1 + idxmax_ = active_timers + end if + + if (global_) then + if (allocated(timers)) then + allocate(ptimers(timer_entries_,size(timers,2)),stat=info) + if (info /= 0) then + write(0,*) 'Error while trying to allocate temporary ',info + call psb_abort(ictxt) + end if + ptimers = timers + call psb_max(ictxt,ptimers) + if (me == psb_root_) then + do i=idxmin_, idxmax_ + call print_timer(me, ptimers(:,i), timers_descr(i), iout) + end do + end if + end if + else + if ((proc_ == -1).or.(me==proc_)) then + do i=idxmin_, idxmax_ + call print_timer(me, ptimers(:,i), timers_descr(i), iout) + end do + end if + end if + + end subroutine psb_print_timers + + subroutine psb_reset_timers() + active_timers = 0 + if (allocated(nsamples)) nsamples = 0 + if (allocated(timers)) then + timers = dzero + timers(timer_min_,:) = -huge(dzero) + end if + wanted = .true. + wanted(timer_tic_) = .false. + wanted(timer_toc_) = .false. + entries_descr(timer_tic_)%data = "tic" + entries_descr(timer_toc_)%data = "toc" + entries_descr(timer_x_)%data = "Time" + entries_descr(timer_sum_)%data = "Total time" + entries_descr(timer_max_)%data = "Max time " + entries_descr(timer_avg_)%data = "Average time" + entries_descr(timer_min_)%data = "Min time" + + end subroutine psb_reset_timers + + subroutine psb_init_timers(ntimers) + implicit none + integer(psb_ipk_), optional :: ntimers + integer(psb_ipk_) :: ntimers_, info + + if (present(ntimers)) then + ntimers_ = ntimers + else + ntimers_ = ntchunk + end if + call reallocate_timers(ntimers_,info) + if (info == 0) call psb_reset_timers() + + end subroutine psb_init_timers + + subroutine reallocate_timers(tsz,info) + implicit none + integer(psb_ipk_), intent(in) :: tsz + integer(psb_ipk_), intent(out) :: info + + call psb_realloc(timer_entries_,tsz,timers,info) + if (info == 0) call psb_realloc(tsz,nsamples,info) + if (info == 0) call psb_realloc(tsz,timers_descr,info) + + end subroutine reallocate_timers + + function psb_get_timer_idx(string) result(val) + implicit none + integer(psb_ipk_) :: val + character(len=*), intent(in), optional :: string + integer(psb_ipk_) :: info + + val = -1 + if (.not.allocated(timers)) call psb_init_timers() + if (active_timers >= size(timers,2)) then + call reallocate_timers((active_timers+ntchunk),info) + if (info /= 0) return + nsamples(active_timers+1:) = 0 + timers(:,active_timers+1:) = dzero + timers(timer_min_,active_timers+1:) = -huge(dzero) + end if + active_timers = active_timers + 1 + if (present(string)) then + timers_descr(active_timers)%data = string + end if + val = active_timers + end function psb_get_timer_idx + + function psb_get_timer(idx) result(val) + implicit none + real(psb_dpk_) :: val + integer(psb_ipk_), intent(in) :: idx + ! + integer(psb_ipk_) :: info + + val = dzero + if ((1<=idx).and.(idx <= active_timers)) then + val = timers(timer_x_,idx) + end if + end function psb_get_timer + + subroutine psb_tic(idx) + implicit none + integer(psb_ipk_), intent(in) :: idx + + if ((1<=idx).and.(idx <= active_timers)) & + & timers(timer_tic_,idx) = psb_wtime() + + end subroutine psb_tic + + subroutine psb_toc(idx) + implicit none + integer(psb_ipk_), intent(in) :: idx + + if ((1<=idx).and.(idx <= active_timers)) then + timers(timer_toc_,idx) = psb_wtime() + timers(timer_x_,idx) = & + & timers(timer_toc_,idx) - timers(timer_tic_,idx) + nsamples(idx) = nsamples(idx) + 1 + timers(timer_sum_,idx) = & + & timers(timer_sum_,idx) + timers(timer_x_,idx) + timers(timer_avg_,idx) = timers(timer_sum_,idx) / nsamples(idx) + timers(timer_max_,idx) = & + & max(timers(timer_max_,idx), timers(timer_x_,idx)) + ! Trick: keep the MAX of negative times, so that + ! a MAX over all processes for an entire section + ! will give the MIN for the MIN entry. + timers(timer_min_,idx) = & + & max(timers(timer_min_,idx), (-timers(timer_x_,idx))) + end if + end subroutine psb_toc + + Subroutine psb_string_item_realloc(len,rrax,info,lb) + use psb_const_mod + use psb_error_mod + implicit none + ! ...Subroutine Arguments + integer(psb_ipk_),Intent(in) :: len + type(psb_string_item),allocatable, intent(inout) :: rrax(:) + integer(psb_ipk_) :: info + integer(psb_ipk_), optional, intent(in) :: lb + + ! ...Local Variables + type(psb_string_item),allocatable :: tmp(:) + integer(psb_ipk_) :: dim,err_act,err, lb_, lbi,ub_ + character(len=20) :: name + logical, parameter :: debug=.false. + + name='psb_string_item_realloc' + call psb_erractionsave(err_act) + info=psb_success_ + + if (present(lb)) then + lb_ = lb + else + lb_ = 1 + endif + if ((len<0)) then + err=4025 + call psb_errpush(err,name, & + & i_err=(/len,izero,izero,izero,izero/),a_err='real(psb_dpk_)') + goto 9999 + end if + ub_ = lb_ + len-1 + + if (allocated(rrax)) then + dim = size(rrax) + lbi = lbound(rrax,1) + If ((dim /= len).or.(lbi /= lb_)) Then + Allocate(tmp(lb_:ub_),stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, & + & i_err=(/len,izero,izero,izero,izero/),a_err='real(psb_dpk_)') + goto 9999 + end if + tmp(lb_:lb_-1+min(len,dim))=rrax(lbi:lbi-1+min(len,dim)) + call move_alloc(tmp,rrax) + End If + else + dim = 0 + Allocate(rrax(lb_:ub_),stat=info) + if (info /= psb_success_) then + err=4025 + call psb_errpush(err,name, & + & i_err=(/len,izero,izero,izero,izero/),a_err='real(psb_dpk_)') + goto 9999 + end if + endif + + call psb_erractionrestore(err_act) + return + +9999 continue + info = err + call psb_error_handler(err_act) + return + + End Subroutine psb_string_item_realloc + + +end module psb_timers_mod +