From f1b3a9f922860afc3c397b5a33910f6985b33149 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 14 Feb 2018 17:54:42 +0000 Subject: [PATCH 1/2] Add global option for psb_cdprt --- base/tools/psb_cdprt.f90 | 43 ++++++++++++++++++++++++++++++++++++++-- 1 file changed, 41 insertions(+), 2 deletions(-) diff --git a/base/tools/psb_cdprt.f90 b/base/tools/psb_cdprt.f90 index 7185f520..3a040ad1 100644 --- a/base/tools/psb_cdprt.f90 +++ b/base/tools/psb_cdprt.f90 @@ -105,14 +105,14 @@ subroutine psb_cdprt(iout,desc_p,glob,short, verbosity) if (me==psb_root_) write(iout,*) 'Communication data for : comm_halo' do i=0, np-1 if (me == i) & - & call print_my_xchg(iout,desc_p,verbosity=verb_,data=psb_comm_halo_) + & call print_my_xchg(iout,desc_p,verbosity=verb_,data=psb_comm_halo_,glob=glob_) call psb_barrier(ictxt) end do if (me==psb_root_) write(iout,*) 'Communication data for : comm_ext' do i=0, np-1 if (me == i) & - & call print_my_xchg(iout,desc_p,verbosity=verb_,data=psb_comm_ext_) + & call print_my_xchg(iout,desc_p,verbosity=verb_,data=psb_comm_ext_,glob=glob_) call psb_barrier(ictxt) end do @@ -129,6 +129,7 @@ contains integer(psb_ipk_) :: ip, nerv, nesd, totxch,idxr,idxs integer(psb_ipk_) :: ictxt, me, np, data_, info, verb_ + integer(psb_ipk_), allocatable :: gidx(:) class(psb_i_base_vect_type), pointer :: vpnt ictxt = desc_p%get_ctxt() @@ -145,6 +146,9 @@ contains end if call psb_cd_v_get_list(data_,desc_p,vpnt,totxch,idxr,idxs,info) + if (glob) & + & call psb_realloc(max(idxr,idxs,1),gidx,info) + select case(verb_) case (1) write(iout,*) me,': Total exchanges :',totxch @@ -174,6 +178,41 @@ contains ip = ip+nerv+nesd+3 end do end associate + case (3) + write(iout,*) me,': Total exchanges :',totxch + write(iout,*) me,': Total sends :',idxs + write(iout,*) me,': Total receives :', idxr + if (totxch == 0) return + if (.not.associated(vpnt)) return + if (.not.allocated(vpnt%v)) return + associate(idx => vpnt%v) + ip = 1 + do + if (ip > size(idx)) then + write(psb_err_unit,*) ': Warning: out of size of input vector ' + exit + end if + if (idx(ip) == -1) exit + totxch = totxch+1 + nerv = idx(ip+psb_n_elem_recv_) + nesd = idx(ip+nerv+psb_n_elem_send_) + write(iout,*) ' ',me,': Exchanging with:',idx(ip),' Sends:',nesd,' Receives:', nerv + if (glob) then + call desc_p%l2g(idx(ip+nerv+psb_n_elem_send_+1:ip+nerv+psb_n_elem_send_+nesd),gidx,info) + write(iout,*) ' ',me,': sending to:',idx(ip),' :',gidx(1:nesd) + call desc_p%l2g(idx(ip+psb_n_elem_recv_+1:ip+psb_n_elem_recv_+nerv),gidx,info) + write(iout,*) ' ',me,': rcvng from:',idx(ip),' :',gidx(1:nerv) + else + write(iout,*) ' ',me,': sending to:',idx(ip),' :',& + & idx(ip+nerv+psb_n_elem_send_+1:ip+nerv+psb_n_elem_send_+nesd) + write(iout,*) ' ',me,': rcvng from:',idx(ip),' :',& + & idx(ip+psb_n_elem_recv_+1:ip+psb_n_elem_recv_+nerv) + end if + idxs = idxs + nesd + idxr = idxr + nerv + ip = ip+nerv+nesd+3 + end do + end associate case default ! Do nothing end select From d98dec4a4a39307343bffdee5f0d9611db66e87c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 15 Feb 2018 08:02:05 +0000 Subject: [PATCH 2/2] Fixed name strings in Xdot --- base/psblas/psb_cdot.f90 | 2 +- base/psblas/psb_ddot.f90 | 2 +- base/psblas/psb_sdot.f90 | 2 +- base/psblas/psb_zdot.f90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/base/psblas/psb_cdot.f90 b/base/psblas/psb_cdot.f90 index 7e669761..cf7d5f01 100644 --- a/base/psblas/psb_cdot.f90 +++ b/base/psblas/psb_cdot.f90 @@ -67,7 +67,7 @@ function psb_cdot_vect(x, y, desc_a,info) result(res) & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr character(len=20) :: name, ch_err - name='psb_sdot' + name='psb_cdot_vect' res = czero if (psb_errstatus_fatal()) return info=psb_success_ diff --git a/base/psblas/psb_ddot.f90 b/base/psblas/psb_ddot.f90 index 3d79266a..2a2b00f3 100644 --- a/base/psblas/psb_ddot.f90 +++ b/base/psblas/psb_ddot.f90 @@ -67,7 +67,7 @@ function psb_ddot_vect(x, y, desc_a,info) result(res) & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr character(len=20) :: name, ch_err - name='psb_sdot' + name='psb_ddot_vect' res = dzero if (psb_errstatus_fatal()) return info=psb_success_ diff --git a/base/psblas/psb_sdot.f90 b/base/psblas/psb_sdot.f90 index e6da978a..86627f07 100644 --- a/base/psblas/psb_sdot.f90 +++ b/base/psblas/psb_sdot.f90 @@ -67,7 +67,7 @@ function psb_sdot_vect(x, y, desc_a,info) result(res) & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr character(len=20) :: name, ch_err - name='psb_sdot' + name='psb_sdot_vect' res = szero if (psb_errstatus_fatal()) return info=psb_success_ diff --git a/base/psblas/psb_zdot.f90 b/base/psblas/psb_zdot.f90 index 1ff86719..a9cd1d98 100644 --- a/base/psblas/psb_zdot.f90 +++ b/base/psblas/psb_zdot.f90 @@ -67,7 +67,7 @@ function psb_zdot_vect(x, y, desc_a,info) result(res) & err_act, iix, jjx, ix, ijx, iy, ijy, iiy, jjy, i, m, nr character(len=20) :: name, ch_err - name='psb_sdot' + name='psb_zdot_vect' res = zzero if (psb_errstatus_fatal()) return info=psb_success_