From 4afc6f1f41e8c556648a0e730e78aab021a9664c Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 15 Apr 2012 18:40:41 +0000 Subject: [PATCH] psblas3: base/modules/psb_base_tools_mod.f90 base/tools/psb_cd_inloc.f90 base/tools/psb_cdall.f90 New interface to allow LIDX with VL. To be documented; also, need to add LIDX to CDINS. --- base/modules/psb_base_tools_mod.f90 | 10 +++++----- base/tools/psb_cd_inloc.f90 | 21 +++++++++++++++++---- base/tools/psb_cdall.f90 | 11 ++++++----- 3 files changed, 28 insertions(+), 14 deletions(-) diff --git a/base/modules/psb_base_tools_mod.f90 b/base/modules/psb_base_tools_mod.f90 index 939acf12..c24a4e4c 100644 --- a/base/modules/psb_base_tools_mod.f90 +++ b/base/modules/psb_base_tools_mod.f90 @@ -422,17 +422,17 @@ module psb_cd_tools_mod interface psb_cdall - subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck) + subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,& + & globalcheck,lidx) import :: psb_ipk_, psb_desc_type, psb_parts implicit None procedure(psb_parts) :: parts - integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl + integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) integer(psb_ipk_), intent(in) :: flag logical, intent(in) :: repl, globalcheck integer(psb_ipk_), intent(out) :: info - type(psb_desc_type), intent(out) :: desc - - optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck + type(psb_desc_type), intent(out) :: desc + optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx end subroutine psb_cdall end interface diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index c9d9672f..1e3b8d68 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -41,7 +41,7 @@ ! ictxt - integer. The communication context. ! desc - type(psb_desc_type). The communication descriptor. ! info - integer. Eventually returns an error code -subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) +subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) use psb_base_mod use psi_mod use psb_repl_map_mod @@ -53,11 +53,12 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc logical, intent(in), optional :: globalcheck + integer(psb_ipk_), intent(in), optional :: idx(:) !locals integer(psb_ipk_) :: i,j,np,me,loc_row,err,& & loc_col,nprocs,n, k,glx,nlu,& - & idx, flag_, err_act,m, novrl, norphan,& + & flag_, err_act,m, novrl, norphan,& & npr_ov, itmpov, i_pnt, nrt integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_), allocatable :: temp_ovrlap(:), tmpgidx(:,:), vl(:),& @@ -226,7 +227,20 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) ! Sort, eliminate duplicates, then ! scramble back into original position. - call psb_msort(vl,ix) + ix(1) = -1 + if (present(idx)) then + if (size(idx) >= loc_row) then + do i=1, loc_row + ix(i) = idx(i) + end do + end if + end if + if (idx(1) == -1) then + do i=1, loc_row + ix(i) = i + end do + end if + call psb_msort(vl,ix,flag=psb_sort_keep_idx_) nlu = 1 do i=2,loc_row if (vl(i) /= vl(nlu)) then @@ -237,7 +251,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) end do call psb_msort(ix(1:nlu),vl(1:nlu),flag=psb_sort_keep_idx_) - call psb_nullify_desc(desc) ! diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index 7adc3d98..f09d2d38 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -1,4 +1,4 @@ -subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck) +subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx) use psb_descriptor_type use psb_serial_mod use psb_const_mod @@ -8,13 +8,13 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche use psi_mod implicit None procedure(psb_parts) :: parts - integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl + integer(psb_ipk_), intent(in) :: mg,ng,ictxt, vg(:), vl(:),nl,lidx(:) integer(psb_ipk_), intent(in) :: flag logical, intent(in) :: repl, globalcheck integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc - optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck + optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx interface subroutine psb_cdals(m, n, parts, ictxt, desc, info) @@ -31,13 +31,14 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche integer(psb_ipk_), intent(out) :: info Type(psb_desc_type), intent(out) :: desc end subroutine psb_cdalv - subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck) + subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) use psb_descriptor_type implicit None integer(psb_ipk_), intent(in) :: ictxt, v(:) integer(psb_ipk_), intent(out) :: info type(psb_desc_type), intent(out) :: desc logical, intent(in), optional :: globalcheck + integer(psb_ipk_), intent(in), optional :: idx(:) end subroutine psb_cd_inloc subroutine psb_cdrep(m, ictxt, desc,info) use psb_descriptor_type @@ -125,7 +126,7 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl, globalche nnv = size(vl) end if - call psb_cd_inloc(vl(1:nnv),ictxt,desc,info, globalcheck=globalcheck) + call psb_cd_inloc(vl(1:nnv),ictxt,desc,info, globalcheck=globalcheck,idx=lidx) else if (present(nl)) then