mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-07 23:16:45 +00:00
New timers in descriptor assembly
This commit is contained in:
@@ -105,6 +105,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
use mpi
|
||||
#endif
|
||||
use psb_penv_mod
|
||||
use psb_timers_mod
|
||||
use psi_mod, psb_protect_name => psi_i_desc_index
|
||||
implicit none
|
||||
#ifdef MPI_H
|
||||
@@ -136,6 +137,8 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
& idxr, idxs, iszs, iszr, nesd, nerv, ixp, idx
|
||||
integer(psb_mpk_) :: icomm, minfo
|
||||
|
||||
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
|
||||
integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1, idx_phase4=-1
|
||||
logical, parameter :: usempi=.false.
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
@@ -159,13 +162,22 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
write(debug_unit,*) me,' ',trim(name),': start'
|
||||
call psb_barrier(ictxt)
|
||||
endif
|
||||
if ((do_timings).and.(idx_phase1==-1)) &
|
||||
& idx_phase1 = psb_get_timer_idx("I_DSC_IDX: phase1 ")
|
||||
if ((do_timings).and.(idx_phase2==-1)) &
|
||||
& idx_phase2 = psb_get_timer_idx("I_DSC_IDX: phase2 ")
|
||||
if ((do_timings).and.(idx_phase3==-1)) &
|
||||
& idx_phase3 = psb_get_timer_idx("I_DSC_IDX: phase3 ")
|
||||
if ((do_timings).and.(idx_phase4==-1)) &
|
||||
& idx_phase4 = psb_get_timer_idx("I_DSC_IDX: phase4 ")
|
||||
|
||||
if (do_timings) call psb_tic(idx_phase1)
|
||||
!
|
||||
! first, find out the sizes to be exchanged.
|
||||
! note: things marked here as sndbuf/rcvbuf (for mpi) corresponds to things
|
||||
! to be received/sent (in the final psblas descriptor).
|
||||
! be careful of the inversion
|
||||
!
|
||||
!
|
||||
allocate(sdsz(np),rvsz(np),bsdindx(np),brvindx(np),stat=info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_alloc_dealloc_
|
||||
@@ -239,6 +251,8 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
if (do_timings) call psb_toc(idx_phase1)
|
||||
if (do_timings) call psb_tic(idx_phase2)
|
||||
|
||||
!
|
||||
! Second build the lists of requests
|
||||
@@ -285,6 +299,8 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
brvindx(proc+1) = idxr
|
||||
idxr = idxr + rvsz(proc+1)
|
||||
end do
|
||||
if (do_timings) call psb_toc(idx_phase2)
|
||||
if (do_timings) call psb_tic(idx_phase3)
|
||||
|
||||
if (usempi) then
|
||||
call mpi_alltoallv(sndbuf,sdsz,bsdindx,psb_mpi_lpk_,&
|
||||
@@ -357,6 +373,8 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
|
||||
end if
|
||||
end if
|
||||
if (do_timings) call psb_toc(idx_phase3)
|
||||
if (do_timings) call psb_tic(idx_phase4)
|
||||
|
||||
!
|
||||
! at this point we can finally build the output desc_index. beware
|
||||
@@ -386,7 +404,7 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,&
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (do_timings) call psb_toc(idx_phase4)
|
||||
if (debug_level >= psb_debug_inner_) then
|
||||
write(debug_unit,*) me,' ',trim(name),': done'
|
||||
call psb_barrier(ictxt)
|
||||
|
||||
@@ -147,7 +147,7 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
|
||||
integer(psb_ipk_) :: err
|
||||
integer(psb_ipk_) :: debug_level, debug_unit
|
||||
integer(psb_mpk_) :: iictxt, icomm, me, np, minfo
|
||||
logical, parameter :: dist_symm_list=.false., print_dl=.false.
|
||||
logical, parameter :: dist_symm_list=.false., print_dl=.false., profile=.true.
|
||||
character name*20
|
||||
name='psi_extrct_dl'
|
||||
|
||||
@@ -257,6 +257,9 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
|
||||
call psi_symm_dep_list(itmp,ictxt,info)
|
||||
dl_lda = max(size(itmp),1)
|
||||
call psb_max(iictxt, dl_lda)
|
||||
|
||||
if (debug_level >= psb_debug_inner_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda
|
||||
call psb_realloc(dl_lda,itmp,info)
|
||||
! dl_lda = min(np,2*dl_lda)
|
||||
allocate(dep_list(dl_lda,0:np),stat=info)
|
||||
@@ -282,6 +285,8 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
|
||||
|
||||
dl_lda = max(length_dl(me),1)
|
||||
call psb_max(iictxt, dl_lda)
|
||||
if (debug_level >= psb_debug_inner_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda
|
||||
allocate(dep_list(dl_lda,0:np),stat=info)
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
|
||||
@@ -362,6 +367,16 @@ subroutine psi_i_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,&
|
||||
end if
|
||||
call psb_barrier(ictxt)
|
||||
end if
|
||||
if ((profile).and.(me==0)) then
|
||||
block
|
||||
integer(psb_ipk_) :: dlmax, dlavg
|
||||
dlmax = maxval(length_dl(:))
|
||||
dlavg = (sum(length_dl(:))+np-1)/np
|
||||
if (dlmax>0) write(0,*) 'Dependency list : max:',dlmax,&
|
||||
& ' avg:',dlavg, ((dlmax>np/2).or.((dlavg>=np/4).and.(np>128)))
|
||||
|
||||
end block
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
@@ -65,7 +65,7 @@ subroutine psb_icdasb(desc,info,ext_hv,mold)
|
||||
integer(psb_ipk_) :: i, n_col, dectype, err_act, n_row
|
||||
integer(psb_mpk_) :: np,me, icomm, ictxt
|
||||
logical :: ext_hv_
|
||||
logical, parameter :: do_timings=.false.
|
||||
logical, parameter :: do_timings=.true.
|
||||
integer(psb_ipk_), save :: idx_phase1=-1, idx_phase2=-1, idx_phase3=-1
|
||||
integer(psb_ipk_), save :: idx_phase11=-1, idx_phase12=-1, idx_phase13=-1
|
||||
integer(psb_ipk_), save :: idx_total=-1
|
||||
|
||||
Reference in New Issue
Block a user