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.
psblas-3.0-maint
Salvatore Filippone 13 years ago
parent 53c63b288f
commit 4afc6f1f41

@ -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
optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
end subroutine psb_cdall
end interface

@ -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)
!

@ -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

Loading…
Cancel
Save