Changed realloc and blacs_env IFDEFs. In realloc we now IFDEF on

MOVE_ALLOC.
Changed descriptor_type to allow for an implementation avoiding
GLOB_TO_LOC of size M for very large M.

src/modules/blacs_env.F90

@@ -1,11 +1,11 @@
 subroutine psb_set_coher(ictxt,isvch)
   integer :: ictxt, isvch
   ! Ensure global coherence for convergence checks.
-#ifdef NORMAL
+#ifdef NETLIB_BLACS
   Call blacs_get(ictxt,16,isvch)
   Call blacs_set(ictxt,16,1)
 #endif
-#ifdef HAVE_ESSL
+#ifdef ESSL_BLACS
   ! Do nothing: ESSL does coherence by default,
   ! and does not handle req=16 
 #endif
@@ -13,10 +13,10 @@ end subroutine psb_set_coher
 subroutine psb_restore_coher(ictxt,isvch)
   integer :: ictxt, isvch
   ! Ensure global coherence for convergence checks.
-#ifdef NORMAL
+#ifdef NETLIB_BLACS
   Call blacs_set(ictxt,16,isvch)
 #endif
-#ifdef HAVE_ESSL
+#ifdef ESSL_BLACS
   ! Do nothing: ESSL does coherence by default,
   ! and does not handle req=16 
 #endif
@@ -31,7 +31,7 @@ subroutine psb_get_rank(rank,ictxt,id)
   rank =  blacs_pnum(ictxt,id,0)
 end subroutine psb_get_rank
 
-#ifdef HAVE_ESSL
+#ifdef ESSL_BLACS
 !
 ! Need these, as they are not in the ESSL implementation 
 ! of the BLACS. 

src/modules/psb_const_mod.f90

@@ -71,6 +71,11 @@ module psb_const_mod
   integer, parameter :: psb_desc_repl_=3199
   integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
   integer, parameter :: psb_desc_upd_asb_=psb_desc_upd_+1
+  integer, parameter :: psb_desc_large_asb_=psb_desc_upd_asb_+1
+  integer, parameter :: psb_desc_large_bld_=psb_desc_large_asb_+1
+  integer, parameter :: nbits=14
+  integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1
+  integer, parameter :: psb_default_large_threshold=4*1024*1024   ! to be reviewed
   integer, parameter :: psb_hpnt_nentries_=7
 
   !

src/modules/psb_desc_type.f90

@@ -58,14 +58,32 @@ module psb_descriptor_type
      ! contain for each global element the corresponding local index,
      ! if exist.
      integer, allocatable :: glob_to_loc (:)
+     integer, allocatable :: hashv(:), glb_lc(:,:), ptree(:)
      ! local renumbering induced by sparse matrix storage. 
      integer, allocatable :: lprm(:)
      ! index space in case it is not just the contiguous range 1:n
      integer, allocatable :: idx_space(:)
   end type psb_desc_type
 
+
+
+
+  integer, private, save :: cd_large_threshold=psb_default_large_threshold 
+
+
 contains 
 
+  subroutine psb_cd_set_large_threshold(ith)
+    integer, intent(in) :: ith
+    if (ith > 0) then 
+      cd_large_threshold = ith
+    end if
+  end subroutine psb_cd_set_large_threshold
+
+  integer function  psb_cd_get_large_threshold()
+    psb_cd_get_large_threshold = cd_large_threshold 
+  end function psb_cd_get_large_threshold
+
   subroutine psb_nullify_desc(desc)
     type(psb_desc_type), intent(inout) :: desc
     
@@ -76,6 +94,7 @@ contains
   end subroutine psb_nullify_desc
 
   logical function psb_is_ok_desc(desc)
+
     type(psb_desc_type), intent(in) :: desc
 
     psb_is_ok_desc = psb_is_ok_dec(psb_cd_get_dectype(desc))
@@ -89,6 +108,13 @@ contains
 
   end function psb_is_bld_desc
 
+  logical function psb_is_large_desc(desc)
+    type(psb_desc_type), intent(in) :: desc
+
+    psb_is_large_desc = psb_is_large_dec(psb_cd_get_dectype(desc))
+
+  end function psb_is_large_desc
+
   logical function psb_is_upd_desc(desc)
     type(psb_desc_type), intent(in) :: desc
 
@@ -116,14 +142,15 @@ contains
 
     psb_is_ok_dec = ((dectype == psb_desc_asb_).or.(dectype == psb_desc_bld_).or.&
          &(dectype == psb_desc_upd_).or.(dectype== psb_desc_upd_asb_).or.&
+         &(dectype == psb_desc_large_asb_).or.(dectype == psb_desc_large_bld_).or.&
          &(dectype== psb_desc_repl_))
-
   end function psb_is_ok_dec
 
   logical function psb_is_bld_dec(dectype)
     integer :: dectype
 
-    psb_is_bld_dec = (dectype == psb_desc_bld_)
+    psb_is_bld_dec = (dectype == psb_desc_bld_)&
+         & .or.(dectype == psb_desc_large_bld_)
   end function psb_is_bld_dec
 
   logical function psb_is_upd_dec(dectype)          
@@ -143,13 +170,13 @@ contains
   logical function psb_is_asb_dec(dectype)
     integer :: dectype
 
-    psb_is_asb_dec = (dectype == psb_desc_asb_).or.&
+    psb_is_asb_dec = (dectype == psb_desc_asb_)&
+         & .or.(dectype == psb_desc_large_asb_).or.&
          & (dectype== psb_desc_repl_)
 
   end function psb_is_asb_dec
 
 
-
   integer function psb_cd_get_local_rows(desc)
     type(psb_desc_type), intent(in) :: desc
     
@@ -186,4 +213,19 @@ contains
     psb_cd_get_dectype = desc%matrix_data(psb_dec_type_)
   end function psb_cd_get_dectype
 
+  integer function psb_cd_get_mpic(desc)
+    type(psb_desc_type), intent(in) :: desc
+    
+    psb_cd_get_mpic = desc%matrix_data(psb_mpi_c_)
+  end function psb_cd_get_mpic
+    
+  logical function psb_is_large_dec(dectype)
+    integer :: dectype
+
+    psb_is_large_dec = (dectype == psb_desc_large_asb_)&
+         & .or.(dectype == psb_desc_large_bld_)
+
+  end function psb_is_large_dec
+
+    
 end module psb_descriptor_type

src/modules/psb_penv_mod.f90

@@ -142,7 +142,6 @@ module psb_penv_mod
   end interface
 
 
- 
 contains 
 
 

src/modules/psb_prec_mod.f90

@@ -150,4 +150,55 @@ module psb_prec_mod
     end subroutine psb_zprc_aply1
   end interface
 
+  interface psb_baseprc_bld
+    subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
+      Use psb_spmat_type
+      use psb_descriptor_type
+      use psb_prec_type
+      type(psb_dspmat_type), target              :: a
+      type(psb_desc_type), intent(in), target    :: desc_a
+      type(psb_dbaseprc_type),intent(inout)      :: p
+      integer, intent(out)                       :: info
+      character, intent(in), optional            :: upd
+    end subroutine psb_dbaseprc_bld
+    subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
+      Use psb_spmat_type
+      use psb_descriptor_type
+      use psb_prec_type
+      type(psb_zspmat_type), target              :: a
+      type(psb_desc_type), intent(in), target    :: desc_a
+      type(psb_zbaseprc_type),intent(inout)      :: p
+      integer, intent(out)                       :: info
+      character, intent(in), optional            :: upd
+    end subroutine psb_zbaseprc_bld
+  end interface
+
+  interface psb_mlprc_bld
+    subroutine psb_dmlprc_bld(a,desc_a,p,info)
+      use psb_serial_mod
+      use psb_descriptor_type
+      use psb_prec_type
+      use psb_const_mod
+      implicit none 
+
+      type(psb_dspmat_type), intent(in), target :: a
+      type(psb_desc_type), intent(in), target   :: desc_a
+      type(psb_dbaseprc_type), intent(inout), target :: p
+      integer, intent(out)                      :: info
+    end subroutine psb_dmlprc_bld
+    subroutine psb_zmlprc_bld(a,desc_a,p,info)
+      use psb_serial_mod
+      use psb_descriptor_type
+      use psb_prec_type
+      use psb_const_mod
+      implicit none 
+
+      type(psb_zspmat_type), intent(in), target :: a
+      type(psb_desc_type), intent(in), target   :: desc_a
+      type(psb_zbaseprc_type), intent(inout),target :: p
+      integer, intent(out)                      :: info
+    end subroutine psb_zmlprc_bld
+  end interface
+
+
 end module psb_prec_mod

src/modules/psb_prec_type.f90

@@ -683,9 +683,11 @@ contains
       enddo
       deallocate(p%av,stat=info)
     end if
-    ! Do we really need the two below? Probably not.
+
-    ! call psb_cdfree(p%desc_data,info)
+    if (allocated(p%desc_data%matrix_data)) &
-    ! call psb_cdfree(p%desc_ac,info)
+         & call psb_cdfree(p%desc_data,info)
+    if (allocated(p%desc_ac%matrix_data)) &
+         & call psb_cdfree(p%desc_ac,info)
     
     if (allocated(p%dprcparm)) then 
       deallocate(p%dprcparm,stat=info)

src/modules/psb_realloc_mod.F90

@@ -46,8 +46,11 @@ module psb_realloc_mod
 
   interface psb_transfer
     module procedure psb_dtransfer1d
+    module procedure psb_dtransfer2d
     module procedure psb_itransfer1d
+    module procedure psb_itransfer2d
     module procedure psb_ztransfer1d
+    module procedure psb_ztransfer2d
   end interface
 
   Interface psb_safe_cpy
@@ -55,6 +58,10 @@ module psb_realloc_mod
          & psb_dcpy1d, psb_dcpy2d, psb_zcpy1d, psb_zcpy2d
   end Interface
 
+  Interface psb_check_size
+    module procedure psb_icksz1d, psb_dcksz1d, psb_zcksz1d
+  end Interface
+
   interface psb_size
     module procedure psb_isize1d, psb_isize2d,&
          & psb_dsize1d, psb_dsize2d,&
@@ -400,6 +407,7 @@ Contains
       psb_zsize1d = size(vin)
     end if
   end function psb_zsize1d
+
   function psb_zsize2d(vin,dim)
     integer :: psb_zsize2d
     complex(kind(1.d0)), allocatable, intent(in) :: vin(:,:)
@@ -417,7 +425,157 @@ Contains
   end function psb_zsize2d
 
 
-  Subroutine psb_dreallocate1i(len,rrax,info,pad)
+  Subroutine psb_icksz1d(len,v,info,pad)
+    use psb_error_mod
+
+    ! ...Subroutine Arguments  
+    Integer,Intent(in)                 :: len
+    Integer,allocatable, intent(inout) :: v(:)
+    integer         :: info
+    integer, optional, intent(in) :: pad
+    ! ...Local Variables
+    character(len=20)  :: name
+    logical, parameter :: debug=.false.
+    integer :: isz, err_act
+
+    name='psb_check_size'
+    call psb_erractionsave(err_act)
+
+    if(psb_get_errstatus().ne.0) return 
+    info=0
+    
+    If (len > psb_size(v)) Then
+      isz = max((3*psb_size(v))/2,(len+1))
+      if (present(pad)) then
+        call psb_realloc(isz,v,info,pad=pad)
+      else
+        call psb_realloc(isz,v,info)
+        if (info /= 0) then
+          info=4010
+          call psb_errpush(info,name,a_err='psb_realloc')
+          goto 9999
+        end if
+      End If
+    end If
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act.eq.act_ret) then
+      return
+    else
+      call psb_error()
+    end if
+    return
+
+
+  End Subroutine psb_icksz1d
+
+
+  Subroutine psb_dcksz1d(len,v,info,pad)
+    use psb_error_mod
+
+    ! ...Subroutine Arguments  
+    Integer,Intent(in)                 :: len
+    real(kind(1.d0)),allocatable, intent(inout) :: v(:)
+    integer         :: info
+    real(kind(1.d0)), optional, intent(in) :: pad
+    ! ...Local Variables
+    character(len=20)  :: name
+    logical, parameter :: debug=.false.
+    integer :: isz, err_act
+
+    name='psb_check_size'
+    call psb_erractionsave(err_act)
+
+    if(psb_get_errstatus().ne.0) return 
+    info=0
+    
+    If (len > psb_size(v)) Then
+      isz = max((3*psb_size(v))/2,(len+1))
+      if (present(pad)) then
+        call psb_realloc(isz,v,info,pad=pad)
+      else
+        call psb_realloc(isz,v,info)
+        if (info /= 0) then
+          info=4010
+          call psb_errpush(info,name,a_err='psb_realloc')
+          goto 9999
+        end if
+      End If
+    end If
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act.eq.act_ret) then
+      return
+    else
+      call psb_error()
+    end if
+    return
+
+
+  End Subroutine psb_dcksz1d
+
+
+  Subroutine psb_zcksz1d(len,v,info,pad)
+    use psb_error_mod
+
+    ! ...Subroutine Arguments  
+    Integer,Intent(in)                 :: len
+    complex(kind(1.d0)),allocatable, intent(inout) :: v(:)
+    integer         :: info
+    complex(kind(1.d0)), optional, intent(in) :: pad
+    ! ...Local Variables
+    character(len=20)  :: name
+    logical, parameter :: debug=.false.
+    integer :: isz, err_act
+
+    name='psb_check_size'
+    call psb_erractionsave(err_act)
+
+    if(psb_get_errstatus().ne.0) return 
+    info=0
+    
+    If (len > psb_size(v)) Then
+      isz = max((3*psb_size(v))/2,(len+1))
+      if (present(pad)) then
+        call psb_realloc(isz,v,info,pad=pad)
+      else
+        call psb_realloc(isz,v,info)
+        if (info /= 0) then
+          info=4010
+          call psb_errpush(info,name,a_err='psb_realloc')
+          goto 9999
+        end if
+      End If
+    end If
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act.eq.act_ret) then
+      return
+    else
+      call psb_error()
+    end if
+    return
+
+
+  End Subroutine psb_zcksz1d
+
+
+  Subroutine psb_dreallocate1i(len,rrax,info,pad,lb)
     use psb_error_mod
 
     ! ...Subroutine Arguments  
@@ -425,9 +583,10 @@ Contains
     Integer,allocatable, intent(inout) :: rrax(:)
     integer         :: info
     integer, optional, intent(in) :: pad
+    integer, optional, intent(in) :: lb
     ! ...Local Variables
     Integer,allocatable  :: tmp(:)
-    Integer :: dim, err_act, err,i
+    Integer :: dim, err_act, err,i,lb_
     character(len=20)  :: name
     logical, parameter :: debug=.false.
 
@@ -437,10 +596,16 @@ Contains
     if(psb_get_errstatus().ne.0) return 
     info=0
     if (debug) write(0,*) 'reallocate I',len
+    if (present(lb)) then
+      lb_ = lb
+    else
+      lb_ = 1
+    endif
+
     if (allocated(rrax)) then 
       dim=size(rrax)
       If (dim /= len) Then
-        Allocate(tmp(len),stat=info)
+        Allocate(tmp(lb_:len),stat=info)
         if (info /= 0) then
           err=4000
           call psb_errpush(err,name)
@@ -448,12 +613,12 @@ Contains
         end if
         tmp(1:min(len,dim))=rrax(1:min(len,dim))
         
-        call move_alloc(tmp,rrax)
+        call psb_transfer(tmp,rrax,info)
         
       end if
     else
       dim = 0
-      allocate(rrax(len),stat=info)
+      allocate(rrax(lb_:len),stat=info)
       if (info /= 0) then
         err=4000
         call psb_errpush(err,name)
@@ -481,7 +646,7 @@ Contains
   End Subroutine psb_dreallocate1i
 
 
-  Subroutine psb_dreallocate1d(len,rrax,info,pad)
+  Subroutine psb_dreallocate1d(len,rrax,info,pad,lb)
     use psb_error_mod
 
     ! ...Subroutine Arguments  
@@ -489,10 +654,11 @@ Contains
     Real(kind(1.d0)),allocatable, intent(inout) :: rrax(:)
     integer :: info
     real(kind(1.d0)), optional, intent(in) :: pad
+    integer, optional, intent(in) :: lb
 
     ! ...Local Variables
     Real(kind(1.d0)),allocatable  :: tmp(:)
-    Integer :: dim,err_act,err,i, m
+    Integer :: dim,err_act,err,i, m, lb_
     character(len=20)  :: name
     logical, parameter :: debug=.false.
 
@@ -501,11 +667,17 @@ Contains
     info = 0 
     if (debug) write(0,*) 'reallocate D',len
 
+    if (present(lb)) then
+      lb_ = lb
+    else
+      lb_ = 1
+    endif
+
     if (allocated(rrax)) then 
       dim=size(rrax)
 
       If (dim /= len) Then
-        Allocate(tmp(len),stat=info)
+        Allocate(tmp(lb_:len),stat=info)
         if (info /= 0) then
           err=4000
           call psb_errpush(err,name)
@@ -514,12 +686,12 @@ Contains
         m = min(dim,len)
         tmp(1:m) = rrax(1:m)
         
-        call move_alloc(tmp,rrax)
+        call psb_transfer(tmp,rrax,info)
 
       End If
     else
       dim = 0
-      Allocate(rrax(len),stat=info)
+      Allocate(rrax(lb_:len),stat=info)
       if (info /= 0) then
         err=4000
         call psb_errpush(err,name)
@@ -578,7 +750,7 @@ Contains
         m = min(dim,len)
         tmp(1:m) = rrax(1:m)
 
-        call move_alloc(tmp,rrax)
+        call psb_transfer(tmp,rrax,info)
 
       End If
     else
@@ -642,7 +814,7 @@ Contains
         m = min(dim,len1)
         tmp(1:m,1:min(len2,dim2)) = rrax(1:m,1:min(len2,dim2))
 
-        call move_alloc(tmp,rrax)
+        call psb_transfer(tmp,rrax,info)
 
       End If
     else
@@ -708,7 +880,7 @@ Contains
         m = min(dim,len1)
         tmp(1:m,1:min(len2,dim2)) = rrax(1:m,1:min(len2,dim2))
 
-        call move_alloc(tmp,rrax)
+        call psb_transfer(tmp,rrax,info)
 
       End If
     else
@@ -771,7 +943,7 @@ Contains
         m = min(dim,len1)
         tmp(1:m,1:min(len2,dim2)) = rrax(1:m,1:min(len2,dim2))
 
-        call move_alloc(tmp,rrax)
+        call psb_transfer(tmp,rrax,info)
 
       End If
     else
@@ -945,98 +1117,226 @@ Contains
     return
   End Subroutine psb_dreallocate2i1z
 
-
   Subroutine psb_dtransfer1d(vin,vout,info)
     use psb_error_mod
     real(kind(1.d0)), allocatable, intent(inout) :: vin(:),vout(:)
     integer, intent(out) :: info 
     !
-    ! To be reimplemented with MOVE_ALLOC
     ! 
     info = 0
+#ifdef HAVE_MOVE_ALLOC    
+    
+    if (allocated(vin)) then 
       call move_alloc(vin,vout)
-!!$    
+    else if (allocated(vout)) then 
-!!$    if (.not.allocated(vin) ) then 
+      write(0,*) 'transfer: Clearing output'
-!!$      if (allocated(vout)) then 
+      deallocate(vout)
-!!$        deallocate(vout,stat=info)
+    end if
-!!$      end if
+
-!!$    else if (allocated(vin)) then 
+#else      
-!!$      if (.not.allocated(vout)) then 
+    
-!!$        allocate(vout(size(vin)),stat=info)
+    if (.not.allocated(vin) ) then 
-!!$        if (info /= 0) return
+      if (allocated(vout)) then 
-!!$      else
+        deallocate(vout,stat=info)
-!!$        if (size(vout) /= size(vin)) then 
+      end if
-!!$          deallocate(vout,stat=info)
+    else if (allocated(vin)) then 
-!!$          if (info /= 0) return
+      if (.not.allocated(vout)) then 
-!!$          allocate(vout(size(vin)),stat=info)
+        allocate(vout(size(vin)),stat=info)
-!!$          if (info /= 0) return
+        if (info /= 0) return
-!!$        end if
+      else
-!!$      end if
+        if (size(vout) /= size(vin)) then 
-!!$      vout = vin
+          deallocate(vout,stat=info)
-!!$      deallocate(vin,stat=info)
+          if (info /= 0) return
-!!$    end if
+          allocate(vout(size(vin)),stat=info)
+          if (info /= 0) return
+        end if
+      end if
+      vout = vin
+      deallocate(vin,stat=info)
+    end if
+#endif
   end Subroutine psb_dtransfer1d
 
+  Subroutine psb_dtransfer2d(vin,vout,info)
+    use psb_error_mod
+    real(kind(1.d0)), allocatable, intent(inout) :: vin(:,:),vout(:,:)
+    integer, intent(out) :: info 
+    !
+    ! 
+    info = 0
+#ifdef HAVE_MOVE_ALLOC
+    if (allocated(vin)) then 
+      call move_alloc(vin,vout)
+    else if (allocated(vout)) then 
+      deallocate(vout)
+    end if
+#else
+    
+    if (.not.allocated(vin) ) then 
+      if (allocated(vout)) then 
+        deallocate(vout,stat=info)
+      end if
+    else if (allocated(vin)) then 
+      if (.not.allocated(vout)) then 
+        allocate(vout(size(vin,1),size(vin,2)),stat=info)
+        if (info /= 0) return
+      else
+        if (size(vout) /= size(vin)) then 
+          deallocate(vout,stat=info)
+          if (info /= 0) return
+          allocate(vout(size(vin,1),size(vin,2)),stat=info)
+          if (info /= 0) return
+        end if
+      end if
+      vout = vin
+      deallocate(vin,stat=info)
+    end if
+#endif
+  end Subroutine psb_dtransfer2d
 
   Subroutine psb_ztransfer1d(vin,vout,info)
     use psb_error_mod
     complex(kind(1.d0)), allocatable, intent(inout) :: vin(:),vout(:)
     integer, intent(out) :: info 
     !
-    ! To be reimplemented with MOVE_ALLOC
     ! 
     info = 0
+#ifdef HAVE_MOVE_ALLOC
+    if (allocated(vin)) then 
       call move_alloc(vin,vout)
-!!$    if (.not.allocated(vin) ) then 
+    else if (allocated(vout)) then 
-!!$      if (allocated(vout)) then 
+      deallocate(vout)
-!!$        deallocate(vout,stat=info)
+    end if
-!!$      end if
+#else
-!!$    else if (allocated(vin)) then 
+    if (.not.allocated(vin) ) then 
-!!$      if (.not.allocated(vout)) then 
+      if (allocated(vout)) then 
-!!$        allocate(vout(size(vin)),stat=info)
+        deallocate(vout,stat=info)
-!!$        if (info /= 0) return
+      end if
-!!$      else
+    else if (allocated(vin)) then 
-!!$        if (size(vout) /= size(vin)) then 
+      if (.not.allocated(vout)) then 
-!!$          deallocate(vout,stat=info)
+        allocate(vout(size(vin)),stat=info)
-!!$          if (info /= 0) return
+        if (info /= 0) return
-!!$          allocate(vout(size(vin)),stat=info)
+      else
-!!$          if (info /= 0) return
+        if (size(vout) /= size(vin)) then 
-!!$        end if
+          deallocate(vout,stat=info)
-!!$      end if
+          if (info /= 0) return
-!!$      vout = vin
+          allocate(vout(size(vin)),stat=info)
-!!$      deallocate(vin,stat=info)
+          if (info /= 0) return
-!!$    end if
+        end if
+      end if
+      vout = vin
+      deallocate(vin,stat=info)
+    end if
+#endif
   end Subroutine psb_ztransfer1d
 
+  Subroutine psb_ztransfer2d(vin,vout,info)
+    use psb_error_mod
+    complex(kind(1.d0)), allocatable, intent(inout) :: vin(:,:),vout(:,:)
+    integer, intent(out) :: info 
+    !
+    ! 
+    info = 0
+#ifdef HAVE_MOVE_ALLOC
+    if (allocated(vin)) then 
+      call move_alloc(vin,vout)
+    else if (allocated(vout)) then 
+      deallocate(vout)
+    end if
+#else
+    if (.not.allocated(vin) ) then 
+      if (allocated(vout)) then 
+        deallocate(vout,stat=info)
+      end if
+    else if (allocated(vin)) then 
+      if (.not.allocated(vout)) then 
+        allocate(vout(size(vin,1),size(vin,2)),stat=info)
+        if (info /= 0) return
+      else
+        if (size(vout) /= size(vin)) then 
+          deallocate(vout,stat=info)
+          if (info /= 0) return
+          allocate(vout(size(vin,1),size(vin,2)),stat=info)
+          if (info /= 0) return
+        end if
+      end if
+      vout = vin
+      deallocate(vin,stat=info)
+    end if
+#endif
+  end Subroutine psb_ztransfer2d
 
   Subroutine psb_itransfer1d(vin,vout,info)
     use psb_error_mod
     integer, allocatable, intent(inout) :: vin(:),vout(:)
     integer, intent(out) :: info 
     !
-    ! To be reimplemented with MOVE_ALLOC
     ! 
     info = 0
+#ifdef HAVE_MOVE_ALLOC
+    if (allocated(vin)) then 
       call move_alloc(vin,vout)
-!!$    if (.not.allocated(vin) ) then 
+    else if (allocated(vout)) then 
-!!$      if (allocated(vout)) then 
+      write(0,*) 'transfer: Clearing output'
-!!$        deallocate(vout,stat=info)
+      deallocate(vout)
-!!$      end if
+    end if
-!!$    else if (allocated(vin)) then 
+#else
-!!$      if (.not.allocated(vout)) then 
+    if (.not.allocated(vin) ) then 
-!!$        allocate(vout(size(vin)),stat=info)
+      if (allocated(vout)) then 
-!!$        if (info /= 0) return
+        deallocate(vout,stat=info)
-!!$      else
+      end if
-!!$        if (size(vout) /= size(vin)) then 
+    else if (allocated(vin)) then 
-!!$          deallocate(vout,stat=info)
+      if (.not.allocated(vout)) then 
-!!$          if (info /= 0) return
+        allocate(vout(size(vin)),stat=info)
-!!$          allocate(vout(size(vin)),stat=info)
+        if (info /= 0) return
-!!$          if (info /= 0) return
+      else
-!!$        end if
+        if (size(vout) /= size(vin)) then 
-!!$      end if
+          deallocate(vout,stat=info)
-!!$      vout = vin
+          if (info /= 0) return
-!!$      deallocate(vin,stat=info)
+          allocate(vout(size(vin)),stat=info)
-!!$    end if
+          if (info /= 0) return
+        end if
+      end if
+      vout = vin
+      deallocate(vin,stat=info)
+    end if
+#endif
   end Subroutine psb_itransfer1d
 
+  Subroutine psb_itransfer2d(vin,vout,info)
+    use psb_error_mod
+    integer, allocatable, intent(inout) :: vin(:,:),vout(:,:)
+    integer, intent(out) :: info 
+    !
+    ! 
+    info = 0
+#ifdef HAVE_MOVE_ALLOC
+    if (allocated(vin)) then 
+      call move_alloc(vin,vout)
+    else if (allocated(vout)) then 
+      deallocate(vout)
+    end if
+#else
+    if (.not.allocated(vin) ) then 
+      if (allocated(vout)) then 
+        deallocate(vout,stat=info)
+      end if
+    else if (allocated(vin)) then 
+      if (.not.allocated(vout)) then 
+        allocate(vout(size(vin,1),size(vin,2)),stat=info)
+        if (info /= 0) return
+      else
+        if (size(vout) /= size(vin)) then 
+          deallocate(vout,stat=info)
+          if (info /= 0) return
+          allocate(vout(size(vin,1),size(vin,2)),stat=info)
+          if (info /= 0) return
+        end if
+      end if
+      vout = vin
+      deallocate(vin,stat=info)
+    end if
+#endif
+  end Subroutine psb_itransfer2d
+
 end module psb_realloc_mod

src/modules/psb_spmat_type.f90

@@ -1556,6 +1556,5 @@ contains
 
   end subroutine psb_zspinfo
 
-
 end module psb_spmat_type
 

src/modules/psb_tools_mod.f90

@@ -38,7 +38,7 @@ Module psb_tools_mod
        implicit none
        real(kind(1.d0)), allocatable, intent(out) :: x(:,:)
        type(psb_desc_type), intent(in) :: desc_a
-       integer                         :: info
+       integer,intent(out)             :: info
        integer, optional, intent(in)   :: n
      end subroutine psb_dalloc
      ! 1-D double precision version
@@ -46,7 +46,7 @@ Module psb_tools_mod
        use psb_descriptor_type
        real(kind(1.d0)), allocatable, intent(out)       :: x(:)
        type(psb_desc_type), intent(in) :: desc_a
-       integer                         :: info
+       integer,intent(out)             :: info
        integer, optional, intent(in)   :: n
      end subroutine psb_dallocv
      ! 2-D integer version
@@ -372,6 +372,13 @@ Module psb_tools_mod
        integer, intent(out)              :: info
        Type(psb_desc_type), intent(out)  :: desc_a
      end subroutine psb_cdalv
+     subroutine psb_cd_inloc(v, ictxt, desc_a, info)
+       use psb_descriptor_type
+       implicit None
+       Integer, intent(in)               :: ictxt, v(:)
+       integer, intent(out)              :: info
+       type(psb_desc_type), intent(out)  :: desc_a
+     end subroutine psb_cd_inloc
   end interface
   
 
@@ -398,7 +405,7 @@ Module psb_tools_mod
      subroutine psb_cdtransfer(desc_in, desc_out, info)
        use psb_descriptor_type
        type(psb_desc_type), intent(inout) :: desc_in
-       type(psb_desc_type), intent(out)   :: desc_out
+       type(psb_desc_type), intent(inout)   :: desc_out
        integer, intent(out)               :: info
      end subroutine psb_cdtransfer
   end interface
@@ -413,11 +420,12 @@ Module psb_tools_mod
   end interface
   
   interface psb_cdins
-     subroutine psb_cdins(nz,ia,ja,desc_a,info)
+     subroutine psb_cdins(nz,ia,ja,desc_a,info,ila,jla)
        use psb_descriptor_type
        type(psb_desc_type), intent(inout) :: desc_a
-       Integer, intent(in)                :: nz,IA(:),JA(:)
+       integer, intent(in)                :: nz,ia(:),ja(:)
        integer, intent(out)               :: info
+       integer, optional, intent(out)     :: ila(:), jla(:)
      end subroutine psb_cdins
   end interface
 

src/modules/psi_mod.f90

@@ -28,12 +28,18 @@
 !!$  POSSIBILITY OF SUCH DAMAGE.
 !!$ 
 !!$  
-! Module containing interfaces for subroutine in SRC/F90/INTERNALS
 
 module psi_mod
 
   use psb_descriptor_type
 
+!!$  interface 
+!!$    subroutine psi_inner_cnv(n,x,hashsize,hashmask,hashv,glb_lc)
+!!$      integer, intent(in)    :: n, hashsize,hashmask,hashv(0:),glb_lc(:,:)
+!!$      integer, intent(inout) :: x(:)
+!!$    end subroutine psi_inner_cnv
+!!$  end interface
+ 
   interface
      subroutine psi_compute_size(desc_data,&
           & index_in, dl_lda, info)
@@ -256,6 +262,85 @@ module psi_mod
     module procedure psi_cnv_dsc
   end interface
 
+  interface psi_inner_cnv
+    module procedure psi_inner_cnv1, psi_inner_cnv2
+  end interface
+
+  interface psi_fnd_owner
+     subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
+       use psb_descriptor_type
+       integer, intent(in) :: nv
+       integer, intent(in) ::  idx(:)
+       integer, allocatable, intent(out) ::  iprc(:)
+       type(psb_desc_type), intent(in) :: desc
+       integer, intent(out) :: info
+     end subroutine psi_fnd_owner
+   end interface
+  
+  interface psi_ldsc_pre_halo
+     subroutine psi_ldsc_pre_halo(desc,info)
+       use psb_descriptor_type
+       type(psb_desc_type), intent(inout) :: desc
+       integer, intent(out) :: info
+     end subroutine psi_ldsc_pre_halo
+   end interface
+
+  interface psi_idx_cnv
+     subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned)
+       use psb_descriptor_type
+       integer, intent(in)    :: nv
+       integer, intent(inout) ::  idxin(:)
+       type(psb_desc_type), intent(in) :: desc
+       integer, intent(out) :: info
+       logical, intent(in), optional, target :: mask(:)
+       logical, intent(in), optional :: owned
+     end subroutine psi_idx_cnv1
+     subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned)
+       use psb_descriptor_type
+       integer, intent(in)  :: nv, idxin(:)
+       integer, intent(out) :: idxout(:)
+       type(psb_desc_type), intent(in) :: desc
+       integer, intent(out) :: info
+       logical, intent(in), optional, target :: mask(:)
+       logical, intent(in), optional :: owned
+     end subroutine psi_idx_cnv2
+     subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned)
+       use psb_descriptor_type
+       integer, intent(in)  :: idxin
+       integer, intent(out) :: idxout
+       type(psb_desc_type), intent(in) :: desc
+       integer, intent(out) :: info
+       logical, intent(in), optional, target :: mask
+       logical, intent(in), optional :: owned
+     end subroutine psi_idx_cnvs
+  end interface
+
+  interface psi_idx_ins_cnv
+     subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask)
+       use psb_descriptor_type
+       integer, intent(in)    :: nv
+       integer, intent(inout) ::  idxin(:)
+       type(psb_desc_type), intent(inout) :: desc
+       integer, intent(out) :: info
+       logical, intent(in), optional, target :: mask(:)
+     end subroutine psi_idx_ins_cnv1
+     subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask)
+       use psb_descriptor_type
+       integer, intent(in)  :: nv, idxin(:)
+       integer, intent(out) :: idxout(:)
+       type(psb_desc_type), intent(inout) :: desc
+       integer, intent(out) :: info
+       logical, intent(in), optional, target :: mask(:)
+     end subroutine psi_idx_ins_cnv2
+     subroutine psi_idx_ins_cnvs(idxin,idxout,desc,info,mask)
+       use psb_descriptor_type
+       integer, intent(in)  :: idxin
+       integer, intent(out) :: idxout
+       type(psb_desc_type), intent(inout) :: desc
+       integer, intent(out) :: info
+       logical, intent(in), optional, target :: mask
+     end subroutine psi_idx_ins_cnvs
+  end interface
 
 contains
   
@@ -362,4 +447,87 @@ contains
 
   end subroutine psi_cnv_dsc
 
+
+
+  subroutine psi_inner_cnv1(n,x,hashsize,hashmask,hashv,glb_lc)
+    integer, intent(in)    :: n, hashsize,hashmask,hashv(0:),glb_lc(:,:)
+    integer, intent(inout) :: x(:)
+
+    integer :: i, ih, key, idx,nh,tmp,lb,ub,lm
+    do i=1, n
+      key = x(i) 
+      ih  = iand(key,hashmask)
+      idx = hashv(ih)
+      nh  = hashv(ih+1) - hashv(ih) 
+      if (nh > 0) then 
+        tmp = -1 
+        lb = idx
+        ub = idx+nh-1
+        do 
+          if (lb>ub) exit
+          lm = (lb+ub)/2
+          if (key==glb_lc(lm,1)) then 
+            tmp = lm
+            exit
+          else if (key<glb_lc(lm,1)) then 
+            ub = lm - 1
+          else
+            lb = lm + 1
+          end if
+        end do
+      else 
+        tmp = -1
+      end if
+      if (tmp > 0) then 
+        x(i) = glb_lc(tmp,2)
+      else         
+        x(i) = tmp 
+      end if
+    end do
+  end subroutine psi_inner_cnv1
+
+
+  subroutine psi_inner_cnv2(n,x,y,hashsize,hashmask,hashv,glb_lc)
+    integer, intent(in)  :: n, hashsize,hashmask,hashv(0:),glb_lc(:,:)
+    integer, intent(in)  :: x(:)
+    integer, intent(out) :: y(:)
+
+    integer :: i, ih, key, idx,nh,tmp,lb,ub,lm
+    
+    do i=1, n
+      key = x(i) 
+      ih  = iand(key,hashmask)
+      if (ih > ubound(hashv,1) ) then 
+        write(0,*) ' In inner cnv: ',ih,ubound(hashv)
+        call flush(0)
+      end if
+      idx = hashv(ih)
+      nh  = hashv(ih+1) - hashv(ih) 
+      if (nh > 0) then 
+        tmp = -1 
+        lb = idx
+        ub = idx+nh-1
+        do 
+          if (lb>ub) exit
+          lm = (lb+ub)/2
+          if (key==glb_lc(lm,1)) then 
+            tmp = lm
+            exit
+          else if (key<glb_lc(lm,1)) then 
+            ub = lm - 1
+          else
+            lb = lm + 1
+          end if
+        end do
+      else 
+        tmp = -1
+      end if
+      if (tmp > 0) then 
+        y(i) = glb_lc(tmp,2)
+      else         
+        y(i) = tmp 
+      end if
+    end do
+  end subroutine psi_inner_cnv2
+
 end module psi_mod