psblas3:

base/modules/psb_hash_map_mod.f90
 base/modules/psb_repl_map_mod.f90

Do not copy & call in-place version, take one. To be completed.

base/modules/psb_hash_map_mod.f90

@@ -73,6 +73,7 @@ module psb_hash_map_mod
     procedure, pass(idxmap)  :: asb       => hash_asb
     procedure, pass(idxmap)  :: free      => hash_free
     procedure, pass(idxmap)  :: clone     => hash_clone
+    procedure, pass(idxmap)  :: reinit    => hash_reinit
     procedure, nopass        :: get_fmt   => hash_get_fmt
 
     procedure, nopass        :: row_extendable => hash_row_extendable
@@ -1453,4 +1454,54 @@ contains
 
     
 
+  subroutine hash_reinit(idxmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_hash_map), intent(inout)    :: idxmap
+    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_) :: err_act, nr,nc,k, nl, ictxt, ntot
+    integer(psb_ipk_), allocatable :: idx(:),lidx(:)
+    character(len=20)  :: name='hash_reinit'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+    ictxt = idxmap%get_ctxt()
+    nr = idxmap%get_lr()
+    nc = idxmap%get_lc()
+    ntot = idxmap%get_gr()
+    if (nc>nr) then 
+      lidx = (/(k,k=1,nc)/)
+      idx  = (/(k,k=1,nc)/)
+      call idxmap%l2gip(idx,info)
+    end if
+    if (info /= 0) &
+         & write(0,*) 'From l2gip',info
+    
+    call idxmap%free()
+    call hash_init_vlu(idxmap,ictxt,ntot,nr,idx(1:nr),info)
+    if (nc>nr) then 
+      call idxmap%g2lip_ins(idx(nr+1:nc),info,lidx=lidx(nr+1:nc))
+    end if
+
+      
+    if (info /= psb_success_) then 
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+    return
+  end subroutine hash_reinit
+
+  
 end module psb_hash_map_mod

base/modules/psb_repl_map_mod.f90

@@ -196,11 +196,49 @@ contains
     logical, intent(in), optional :: mask(:)
     logical, intent(in), optional :: owned
     integer(psb_ipk_) :: is, im
+    integer(psb_ipk_) :: i
+    logical :: owned_
     
+    info = 0
     is = size(idxin)
     im = min(is,size(idxout))
-    idxout(1:im) = idxin(1:im)
+
-    call idxmap%l2gip(idxout(1:im),info,mask,owned)
+    if (present(mask)) then 
+      if (size(mask) < im) then 
+        info = -1
+        return
+      end if
+    end if
+    if (present(owned)) then 
+      owned_ = owned
+    else
+      owned_ = .false.
+    end if
+
+    if (present(mask)) then 
+
+      do i=1, im
+        if (mask(i)) then 
+          if ((1<=idxin(i)).and.(idxin(i) <= idxmap%local_rows)) then
+            idxout(i) = idxin(i)
+          else 
+            idxout(i) = -1
+          end if
+        end if
+      end do
+
+    else  if (.not.present(mask)) then 
+
+      do i=1, im
+          if ((1<=idxin(i)).and.(idxin(i) <= idxmap%local_rows)) then
+            idxout(i) = idxin(i)
+          else 
+            idxout(i) = -1
+          end if
+      end do
+
+    end if
+
     if (is > im) info = -3 
 
   end subroutine repl_l2gv2
@@ -331,12 +369,79 @@ contains
     logical, intent(in), optional :: mask(:)
     logical, intent(in), optional :: owned
 
-    integer(psb_ipk_) :: is, im
+    integer(psb_ipk_) :: is, im,i
+    logical :: owned_
+
+    info = 0
     
     is = size(idxin)
     im = min(is,size(idxout))
-    idxout(1:im) = idxin(1:im)
+
-    call idxmap%g2lip(idxout(1:im),info,mask,owned)
+    if (present(mask)) then 
+      if (size(mask) < im) then 
+        info = -1
+        return
+      end if
+    end if
+    if (present(owned)) then 
+      owned_ = owned
+    else
+      owned_ = .false.
+    end if
+
+
+    if (present(mask)) then 
+
+      if (idxmap%is_asb()) then 
+        do i=1, is
+          if (mask(i)) then 
+            if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+              idxout(i) = idxin(i) 
+            else 
+              idxout(i) = -1
+            end if
+          end if
+        end do
+      else if (idxmap%is_valid()) then 
+        do i=1,is
+          if (mask(i)) then 
+            if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+              idxout(i) = idxin(i) 
+            else 
+              idxout(i) = -1
+            end if
+          end if
+        end do
+      else 
+        idxout(1:is) = -1
+        info = -1
+      end if
+
+    else  if (.not.present(mask)) then 
+
+      if (idxmap%is_asb()) then 
+        do i=1, is
+          if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+            idxout(i) = idxin(i) 
+          else 
+            idxout(i) = -1
+          end if
+        end do
+      else if (idxmap%is_valid()) then 
+        do i=1,is
+          if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+            idxout(i) = idxin(i) 
+          else 
+            idxout(i) = -1
+          end if
+        end do
+      else 
+        idxout(1:is) = -1
+        info = -1
+      end if
+
+    end if
+
     if (is > im) info = -3 
 
   end subroutine repl_g2lv2
@@ -480,12 +585,82 @@ contains
     logical, intent(in), optional :: mask(:)
     integer(psb_ipk_), intent(in), optional :: lidx(:)
 
-    integer(psb_ipk_) :: is, im
+    integer(psb_ipk_) :: is, im, i
+    
 
+    info = 0
     is = size(idxin)
     im = min(is,size(idxout))
-    idxout(1:im) = idxin(1:im)
+
-    call idxmap%g2lip_ins(idxout(1:im),info,mask=mask,lidx=lidx)
+    if (present(mask)) then 
+      if (size(mask) < im) then 
+        info = -1
+        return
+      end if
+    end if
+    if (present(lidx)) then 
+      if (size(lidx) < im) then 
+        info = -1
+        return
+      end if
+    end if
+
+
+    if (idxmap%is_asb()) then 
+      ! State is wrong for this one ! 
+      idxout = -1
+      info   = -1
+
+    else if (idxmap%is_valid()) then 
+      if (present(lidx)) then 
+        if (present(mask)) then 
+          do i=1, is
+            if (mask(i)) then
+              if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+                idxout(i) = idxin(i) 
+              else 
+                idxout(i) = -1
+              end if
+            end if
+          end do
+
+        else if (.not.present(mask)) then 
+
+          do i=1, is
+            if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+              idxout(i) = idxin(i) 
+            else 
+              idxout(i) = -1
+            end if
+          end do
+        end if
+      else if (.not.present(lidx)) then 
+        if (present(mask)) then 
+          do i=1, is
+            if (mask(i)) then 
+              if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+                idxout(i) = idxin(i) 
+              else 
+                idxout(i) = -1
+              end if
+            end if
+          end do
+
+        else if (.not.present(mask)) then 
+          do i=1, is
+            if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then
+              idxout(i) = idxin(i) 
+            else 
+              idxout(i) = -1
+            end if
+          end do
+        end if
+      end if
+    else 
+      idxout = -1
+      info   = -1
+    end if
+
     if (is > im) info = -3 
 
   end subroutine repl_g2lv2_ins