diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index 68c4615b..2c340805 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -191,11 +191,16 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info) if (do_timings) call psb_tic(idx_phase2) call psi_bld_glb_dep_list(ictxt,& & loc_dl,length_dl,c_dep_list,dl_ptr,info) - + if (info /= 0) then + write(0,*) me,trim(name),' From bld_glb_list ',info + end if !!$ call psi_dl_check(dep_list,dl_lda,np,length_dl) !!$ !!$ ! ....now i can sort dependency lists. call psi_sort_dl(dl_ptr,c_dep_list,length_dl,np,info) + if (info /= 0) then + write(0,*) me,trim(name),' From sort_dl ',info + end if ldl = length_dl(me) loc_dl = c_dep_list(dl_ptr(me):dl_ptr(me)+ldl-1) @@ -253,7 +258,7 @@ contains logical :: val val = .not.(((dlmax>(26*4)).or.((dlavg>=(26*2)).and.(np>=128)))) - val = .true. + !val = .true. end function choose_sorting end subroutine psi_i_crea_index diff --git a/base/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 index 29a55b49..0e7c276e 100644 --- a/base/internals/psi_sort_dl.f90 +++ b/base/internals/psi_sort_dl.f90 @@ -136,7 +136,7 @@ end subroutine psi_i_sort_dl ! node in the dependency list for the current one * ! * !********************************************************************** -subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info) +subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) use psi_mod, psb_protect_name => psi_i_csr_sort_dl use psb_const_mod use psb_error_mod @@ -144,14 +144,18 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info) implicit none integer(psb_ipk_), intent(inout) :: c_dep_list(:), dl_ptr(0:), l_dep_list(0:) - integer(psb_ipk_), intent(in) :: np + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info ! Local variables integer(psb_ipk_), allocatable :: dg(:), dgp(:),& & idx(:), upd(:), edges(:,:), ich(:) integer(psb_ipk_) :: i, j, nedges, ip1, ip2, nch, ip, iedge,& & i1, ix, ist, iswap(2) + logical :: internal_error + integer(psb_ipk_) :: me, np + info = 0 + call psb_info(ictxt,me,np) nedges = size(c_dep_list) allocate(dg(0:np-1),dgp(nedges),edges(2,nedges),upd(0:np-1),& @@ -173,7 +177,7 @@ subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info) do i = 0, np-1 do j = dl_ptr(i),dl_ptr(i+1) - 1 ip = c_dep_list(j) - if (i= i) then iedge = iedge + 1 edges(1,iedge) = i edges(2,iedge) = ip @@ -187,6 +187,7 @@ subroutine srtlist(dep_list,dl_lda,ldl,np,dg,dgp,upd, edges,idx,ich,info) i = edges(2,j) dg(i) = dg(i)+1 dep_list(dg(i),i) = edges(1,j)-1 + if (edges(1,j) == edges(2,j)) dg(i) = dg(i) -1 enddo do i=1, np if (dg(i).ne.ldl(i)) then diff --git a/base/modules/psi_i_mod.F90 b/base/modules/psi_i_mod.F90 index 7a247f8d..35ff1316 100644 --- a/base/modules/psi_i_mod.F90 +++ b/base/modules/psi_i_mod.F90 @@ -111,13 +111,13 @@ module psi_i_mod integer(psb_ipk_) :: np integer(psb_ipk_) :: info end subroutine psi_i_sort_dl - subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,np,info) + subroutine psi_i_csr_sort_dl(dl_ptr,c_dep_list,l_dep_list,ictxt,info) import implicit none - integer(psb_ipk_), intent(in) :: c_dep_list(:), dl_ptr(0:) + integer(psb_ipk_), intent(in) :: c_dep_list(:), dl_ptr(0:) integer(psb_ipk_), intent(inout) :: l_dep_list(0:) - integer(psb_ipk_), intent(in) :: np - integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: ictxt + integer(psb_ipk_) :: info end subroutine psi_i_csr_sort_dl end interface @@ -145,13 +145,13 @@ module psi_i_mod integer(psb_ipk_), intent(out) :: info end subroutine psi_i_bld_glb_dep_list subroutine psi_i_bld_glb_csr_dep_list(ictxt,loc_dl,length_dl,c_dep_list,dl_ptr,info) - import + import integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:) - integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) + integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:) integer(psb_ipk_), intent(out) :: info end subroutine psi_i_bld_glb_csr_dep_list - end interface psi_bld_glb_dep_list + end interface interface psi_extract_loc_dl subroutine psi_i_xtr_loc_dl(ictxt,is_bld,is_upd,desc_str,loc_dl,length_dl,info)