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

@@ -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
+      type(psb_desc_type), intent(out)    :: desc      
-      
+      optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck,lidx
-      optional :: mg,ng,parts,vg,vl,flag,nl,repl, globalcheck
     end subroutine psb_cdall
     
   end interface

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

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