Added dependecies on i_vect_mod.

base/comm/psb_igather.f90

@@ -329,3 +329,121 @@ subroutine  psb_igatherv(globx, locx, desc_a, info, iroot)
   return
 
 end subroutine psb_igatherv
+
+
+subroutine  psb_igather_vect(globx, locx, desc_a, info, iroot)
+  use psb_base_mod, psb_protect_name => psb_igather_vect
+  implicit none
+
+  type(psb_i_vect_type), intent(inout) :: locx
+  integer(psb_ipk_), intent(out), allocatable   :: globx(:)
+  type(psb_desc_type), intent(in)   :: desc_a
+  integer(psb_ipk_), intent(out)              :: info
+  integer(psb_ipk_), intent(in), optional     :: iroot
+
+
+  ! locals
+  integer(psb_mpik_) :: ictxt, np, me, root, iiroot, icomm, myrank, rootrank
+  integer(psb_ipk_) :: ierr(5), err_act, n, ilocx, iglobx, jlocx,&
+       & jglobx, lda_locx, lda_globx, m, k, jlx, ilx, i, idx
+  integer(psb_ipk_), allocatable :: llocx(:)
+  character(len=20)        :: name, ch_err
+
+  name='psb_igatherv'
+  if(psb_get_errstatus() /= 0) return 
+  info=psb_success_
+  call psb_erractionsave(err_act)
+
+  ictxt=desc_a%get_context()
+
+  ! check on blacs grid 
+  call psb_info(ictxt, me, np)
+  if (np == -1) then
+    info = psb_err_context_error_
+    call psb_errpush(info,name)
+    goto 9999
+  endif
+
+  if (present(iroot)) then
+    root = iroot
+    if((root < -1).or.(root > np)) then
+      info=psb_err_input_value_invalid_i_
+      ierr(1)=5; ierr(2)=root;
+      call psb_errpush(info,name,i_err=ierr)
+      goto 9999
+    end if
+  else
+    root = -1
+  end if
+
+  jglobx=1
+  iglobx = 1
+  jlocx=1
+  ilocx = 1
+
+
+  m = desc_a%get_global_rows()
+  n = desc_a%get_global_cols()
+  lda_globx = m
+  lda_locx  = locx%get_nrows()
+  
+  k = 1
+
+
+  !  there should be a global check on k here!!!
+
+  call psb_chkglobvect(m,n,lda_globx,iglobx,jglobx,desc_a,info)
+  if (info == psb_success_) &
+       & call psb_chkvect(m,n,locx%get_nrows(),ilocx,jlocx,desc_a,info,ilx,jlx)
+  if(info /= psb_success_) then
+    info=psb_err_from_subroutine_
+    ch_err='psb_chk(glob)vect'
+    call psb_errpush(info,name,a_err=ch_err)
+    goto 9999
+  end if
+
+  if ((ilx /= 1).or.(iglobx /= 1)) then
+    info=psb_err_ix_n1_iy_n1_unsupported_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+  
+  call psb_realloc(m,globx,info)
+  if (info /= psb_success_) then 
+    info=psb_err_alloc_dealloc_
+    call psb_errpush(info,name)
+    goto 9999
+  end if
+  
+  globx(:) = izero
+  llocx    = locx%get_vect()
+
+  do i=1,desc_a%get_local_rows()
+    call psb_loc_to_glob(i,idx,desc_a,info)
+    globx(idx) = llocx(i)
+  end do
+  
+  ! adjust overlapped elements
+  do i=1, size(desc_a%ovrlap_elem,1)
+    if (me /= desc_a%ovrlap_elem(i,3)) then 
+      idx = desc_a%ovrlap_elem(i,1)
+      call psb_loc_to_glob(idx,desc_a,info)
+      globx(idx) = izero
+    end if
+  end do
+  
+  call psb_sum(ictxt,globx(1:m),root=root)
+
+  call psb_erractionrestore(err_act)
+  return  
+
+9999 continue
+  call psb_erractionrestore(err_act)
+
+  if (err_act == psb_act_abort_) then
+    call psb_error(ictxt)
+    return
+  end if
+  return
+
+end subroutine psb_igather_vect

base/modules/Makefile

@@ -123,7 +123,7 @@ psb_c_psblas_mod.o: psb_c_vect_mod.o psb_c_mat_mod.o
 psb_z_psblas_mod.o: psb_z_vect_mod.o psb_z_mat_mod.o
 psb_psblas_mod.o: psb_s_psblas_mod.o psb_c_psblas_mod.o  psb_d_psblas_mod.o psb_z_psblas_mod.o
 psb_s_psblas_mod.o psb_c_psblas_mod.o psb_d_psblas_mod.o psb_z_psblas_mod.o: psb_mat_mod.o psb_desc_type.o
-psb_vect_mod.o: psb_d_vect_mod.o psb_s_vect_mod.o psb_c_vect_mod.o psb_z_vect_mod.o
+psb_vect_mod.o: psb_i_vect_mod.o psb_d_vect_mod.o psb_s_vect_mod.o psb_c_vect_mod.o psb_z_vect_mod.o
 psb_comm_mod.o: psb_i_comm_mod.o psb_s_comm_mod.o psb_d_comm_mod.o psb_c_comm_mod.o psb_z_comm_mod.o 
 psb_i_comm_mod.o: psb_i_vect_mod.o psb_desc_type.o 
 psb_s_comm_mod.o: psb_s_vect_mod.o psb_desc_type.o psb_mat_mod.o 

base/modules/psb_d_linmap_mod.f90

@@ -124,6 +124,19 @@ module psb_d_linmap_mod
     end function psb_d_linmap
   end interface
 
+  interface psb_linmaps
+    subroutine psb_d_linmaps(mapout,map_kind,desc_X, desc_Y, map_X2Y, map_Y2X,iaggr,naggr)
+      use psb_d_mat_mod, only : psb_dspmat_type
+      import :: psb_ipk_, psb_dlinmap_type, psb_desc_type
+      implicit none 
+      type(psb_dlinmap_type), intent(inout)   :: mapout
+      type(psb_desc_type), target       :: desc_X, desc_Y
+      type(psb_dspmat_type), intent(in) :: map_X2Y, map_Y2X
+      integer(psb_ipk_), intent(in)               :: map_kind
+      integer(psb_ipk_), intent(in), optional     :: iaggr(:), naggr(:)
+    end subroutine psb_d_linmaps
+  end interface
+
   private :: d_map_sizeof, d_is_asb, d_free
 
 

base/modules/psb_vect_mod.f90

@@ -1,4 +1,5 @@
 module psb_vect_mod
+  use psb_i_vect_mod  
   use psb_s_vect_mod
   use psb_d_vect_mod
   use psb_c_vect_mod