psblas3:

base/modules/psb_desc_mod.f90
 base/modules/psb_gen_block_map_mod.f90
 base/modules/psb_indx_map_mod.f90
 base/modules/psb_list_map_mod.f90
 base/modules/psb_repl_map_mod.f90
 base/tools/Makefile
 base/tools/psb_cd_clone.f90
 base/tools/psb_cd_reinit.f90

Fixes for reinit methods.

base/modules/psb_desc_mod.f90

@@ -233,6 +233,16 @@ module psb_desc_mod
 
   end type psb_desc_type
 
+
+  interface 
+    subroutine psb_cd_clone(desc, desc_out, info)
+      import psb_desc_type, psb_ipk_
+      class(psb_desc_type), intent(inout), target :: desc
+      class(psb_desc_type), intent(inout)         :: desc_out
+      integer(psb_ipk_), intent(out)              :: info
+    end subroutine psb_cd_clone
+  end interface
+      
   interface psb_sizeof
     module procedure psb_cd_sizeof
   end interface psb_sizeof
@@ -899,89 +909,6 @@ contains
 
   end Subroutine psb_cd_get_recv_idx
 
-  subroutine psb_cd_clone(desc, desc_out, info)
-
-    use psb_error_mod
-    use psb_penv_mod
-    use psb_realloc_mod
-
-    implicit none
-    !....parameters...
-
-    class(psb_desc_type), intent(inout), target :: desc
-    class(psb_desc_type), intent(inout)         :: desc_out
-    integer(psb_ipk_), intent(out)              :: info
-    !locals
-    integer(psb_ipk_) :: np,me,ictxt, err_act
-    integer(psb_ipk_) :: debug_level, debug_unit
-    character(len=20)   :: name
-
-    debug_unit  = psb_get_debug_unit()
-    debug_level = psb_get_debug_level()
-
-    if (psb_get_errstatus() /= 0) return 
-    info = psb_success_
-    call psb_erractionsave(err_act)
-    name = 'psb_cdcpy'
-
-    if (desc%is_valid()) then 
-      ictxt = desc%get_context()
-
-      ! check on blacs grid 
-      call psb_info(ictxt, me, np)
-      if (debug_level >= psb_debug_ext_) &
-           & write(debug_unit,*) me,' ',trim(name),': Entered'
-      if (np == -1) then
-        info = psb_err_context_error_
-        call psb_errpush(info,name)
-        goto 9999
-      endif
-
-      desc_out%base_desc  => desc%base_desc
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%ovrlap_index,&
-           & desc_out%ovrlap_index,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info)
-      if (info == psb_success_)&
-           & call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info)
-      if ((info == psb_success_).and.(allocated(desc%indxmap))) &
-           & call desc%indxmap%clone(desc_out%indxmap,info)
-    else
-      call desc_out%free(info)
-    end if
-    if (info /= psb_success_) then
-      info = psb_err_from_subroutine_
-      call psb_errpush(info,name)
-      goto 9999
-    endif
-    if (debug_level >= psb_debug_ext_) &
-         & write(debug_unit,*) me,' ',trim(name),': Done'
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-
-    if (err_act == psb_act_ret_) then
-      return
-    else
-      call psb_error(ictxt)
-    end if
-    return
-
-  end subroutine psb_cd_clone
 
 
 end module psb_desc_mod

base/modules/psb_gen_block_map_mod.f90

@@ -64,6 +64,7 @@ module psb_gen_block_map_mod
     procedure, pass(idxmap)  :: asb       => block_asb
     procedure, pass(idxmap)  :: free      => block_free
     procedure, pass(idxmap)  :: clone     => block_clone
+    procedure, pass(idxmap)  :: reinit    => block_reinit
     procedure, nopass        :: get_fmt   => block_get_fmt
 
     procedure, pass(idxmap)  :: l2gs1 => block_l2gs1
@@ -89,7 +90,7 @@ module psb_gen_block_map_mod
        & block_get_fmt, block_l2gs1, block_l2gs2, block_l2gv1,&
        & block_l2gv2, block_g2ls1, block_g2ls2, block_g2lv1,&
        & block_g2lv2, block_g2ls1_ins, block_g2ls2_ins,&
-       & block_g2lv1_ins, block_g2lv2_ins, block_clone
+       & block_g2lv1_ins, block_g2lv2_ins, block_clone, block_reinit
 
   integer(psb_ipk_), private :: laddsz=500
 
@@ -696,6 +697,7 @@ contains
 
   subroutine block_init(idxmap,ictxt,nl,info)
     use psb_penv_mod
+    use psb_realloc_mod
     use psb_error_mod
     implicit none 
     class(psb_gen_block_map), intent(inout) :: idxmap
@@ -743,7 +745,7 @@ contains
     idxmap%min_glob_row = vnl(iam)+1
     idxmap%max_glob_row = vnl(iam+1) 
     call move_alloc(vnl,idxmap%vnl)
-    allocate(idxmap%loc_to_glob(nl),stat=info) 
+    call psb_realloc(nl,idxmap%loc_to_glob,info) 
     if (info /= 0)  then
       info = -2
       return
@@ -854,4 +856,106 @@ contains
     return
   end subroutine block_clone
 
+
+  subroutine block_reinit(idxmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_gen_block_map), intent(inout)    :: idxmap
+    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_) :: err_act, nr,nc,k, nl, ictxt
+    integer(psb_ipk_), allocatable :: idx(:),lidx(:)
+    character(len=20)  :: name='block_reinit'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+
+    nr = idxmap%get_lr()
+    nc = idxmap%get_lc()
+    if (nc>nr) then 
+      lidx = (/(k,k=nr+1,nc)/)
+      idx  = (/(k,k=nr+1,nc)/)
+      call idxmap%l2gip(idx,info)
+    end if
+    if (info /= 0) &
+         & write(0,*) 'From l2gip',info
+
+    
+    call psb_hash_init(nr,idxmap%hash,info)
+    if (info /= 0) &
+         & write(0,*) 'From hash_init',info
+    call idxmap%set_state(psb_desc_bld_)
+    if (nc>nr) then 
+      call idxmap%g2lip_ins(idx,info,lidx=lidx)
+    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 block_reinit
+
+!!$
+!!$  subroutine block_reinit(idxmap,info)
+!!$    use psb_penv_mod
+!!$    use psb_error_mod
+!!$    use psb_realloc_mod
+!!$    implicit none 
+!!$    class(psb_gen_block_map), intent(inout)    :: idxmap
+!!$    integer(psb_ipk_), intent(out) :: info
+!!$    integer(psb_ipk_) :: err_act, nr,nc,k, nl, ictxt
+!!$    integer(psb_ipk_), allocatable :: idx(:),lidx(:)
+!!$    character(len=20)  :: name='block_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()
+!!$    if (nc>nr) then 
+!!$      lidx = (/(k,k=nr+1,nc)/)
+!!$      idx  = (/(k,k=nr+1,nc)/)
+!!$      call idxmap%l2gip(idx,info)
+!!$    end if
+!!$    if (info /= 0) &
+!!$         & write(0,*) 'From l2gip',info
+!!$    
+!!$    call idxmap%init(ictxt,nr,info)
+!!$    if (nc>nr) then 
+!!$      call idxmap%g2lip_ins(idx,info,lidx=lidx)
+!!$    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 block_reinit
+!!$
+
+
 end module psb_gen_block_map_mod

base/modules/psb_indx_map_mod.f90

@@ -1,3 +1,4 @@
+
 !!$ 
 !!$              Parallel Sparse BLAS  version 3.1
 !!$    (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013
@@ -158,6 +159,7 @@ module psb_indx_map_mod
     procedure, pass(idxmap)  :: asb   => base_asb
     procedure, pass(idxmap)  :: free  => base_free
     procedure, pass(idxmap)  :: clone => base_clone
+    procedure, pass(idxmap)  :: reinit => base_reinit
 
     procedure, pass(idxmap)  :: l2gs1  => base_l2gs1
     procedure, pass(idxmap)  :: l2gs2  => base_l2gs2
@@ -196,7 +198,7 @@ module psb_indx_map_mod
        & base_g2ls1, base_g2ls2, base_g2lv1, base_g2lv2,&
        & base_g2ls1_ins, base_g2ls2_ins, base_g2lv1_ins,&
        & base_g2lv2_ins, base_init_vl, base_is_null,&
-       & base_row_extendable, base_clone
+       & base_row_extendable, base_clone, base_reinit
   
   !> Function: psb_indx_map_fnd_owner
   !! \memberof psb_indx_map
@@ -879,4 +881,30 @@ contains
     return
   end subroutine base_clone
 
+
+  subroutine base_reinit(idxmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    implicit none 
+    class(psb_indx_map), intent(inout)    :: idxmap
+    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_) :: err_act
+    character(len=20)  :: name='base_reinit'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+
+    call psb_get_erraction(err_act)
+    ! This is the base version. If we get here
+    ! it means the derived class is incomplete,
+    ! so we throw an error.
+    call psb_errpush(psb_err_missing_override_method_,&
+         & name,a_err=idxmap%get_fmt())
+
+    if (err_act /= psb_act_ret_) then
+      call psb_error()
+    end if
+    return
+  end subroutine base_reinit
+
 end module psb_indx_map_mod

base/modules/psb_list_map_mod.f90

@@ -54,6 +54,7 @@ module psb_list_map_mod
     procedure, pass(idxmap)  :: asb       => list_asb
     procedure, pass(idxmap)  :: free      => list_free
     procedure, pass(idxmap)  :: clone     => list_clone
+    procedure, pass(idxmap)  :: reinit    => list_reinit
     procedure, nopass        :: get_fmt   => list_get_fmt
     procedure, nopass        :: row_extendable => list_row_extendable
 
@@ -705,4 +706,26 @@ contains
     return
   end subroutine list_clone
 
+
+  subroutine list_reinit(idxmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_list_map), intent(inout)    :: idxmap
+    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_) :: err_act, nr,nc,k, nl
+    integer(psb_ipk_), allocatable :: idx(:),lidx(:)
+    character(len=20)  :: name='list_reinit'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+
+    call idxmap%set_state(psb_desc_bld_)
+
+    return
+
+  end subroutine list_reinit
+
+
 end module psb_list_map_mod

base/modules/psb_repl_map_mod.f90

@@ -55,6 +55,7 @@ module psb_repl_map_mod
     procedure, pass(idxmap)  :: asb       => repl_asb
     procedure, pass(idxmap)  :: free      => repl_free
     procedure, pass(idxmap)  :: clone     => repl_clone
+    procedure, pass(idxmap)  :: reinit    => repl_reinit
     procedure, nopass        :: get_fmt   => repl_get_fmt
 
     procedure, pass(idxmap)  :: l2gs1 => repl_l2gs1
@@ -592,6 +593,7 @@ contains
     logical, parameter :: debug=.false.
 
     info = psb_success_
+    write(0,*)name,' Start'
     call psb_get_erraction(err_act)
     if (allocated(outmap)) then 
       write(0,*) 'Error: should not be allocated on input'
@@ -629,4 +631,25 @@ contains
     end if
     return
   end subroutine repl_clone
+
+  subroutine repl_reinit(idxmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_repl_map), intent(inout)    :: idxmap
+    integer(psb_ipk_), intent(out) :: info
+    integer(psb_ipk_) :: err_act, nr,nc,k, nl
+    integer(psb_ipk_), allocatable :: idx(:),lidx(:)
+    character(len=20)  :: name='repl_reinit'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+
+    call idxmap%set_state(psb_desc_bld_)
+
+    return
+
+  end subroutine repl_reinit
+
 end module psb_repl_map_mod

base/tools/Makefile

@@ -6,7 +6,7 @@ FOBJS = psb_sallc.o psb_sasb.o  \
 	psb_dfree.o psb_dins.o \
 	psb_cdall.o psb_cdals.o psb_cdalv.o psb_cd_inloc.o psb_cdins.o psb_cdprt.o \
 	psb_cdren.o psb_cdrep.o psb_get_overlap.o psb_cd_lstext.o\
-	psb_cdcpy.o psb_cd_reinit.o psb_cd_switch_ovl_indxmap.o\
+	psb_cdcpy.o psb_cd_reinit.o psb_cd_switch_ovl_indxmap.o psb_cd_clone.o\
 	psb_dspalloc.o psb_dspasb.o \
 	psb_dspfree.o psb_dspins.o psb_dsprn.o \
 	psb_sspalloc.o psb_sspasb.o \

base/tools/psb_cd_clone.f90

@@ -0,0 +1,90 @@
+  subroutine psb_cd_clone(desc, desc_out, info)
+
+    use psb_error_mod
+    use psb_penv_mod
+    use psb_realloc_mod
+    use psb_desc_mod, psb_protect_name => psb_cd_clone
+    implicit none
+    !....parameters...
+
+    class(psb_desc_type), intent(inout), target :: desc
+    class(psb_desc_type), intent(inout)         :: desc_out
+    integer(psb_ipk_), intent(out)              :: info
+    !locals
+    integer(psb_ipk_) :: np,me,ictxt, err_act
+    integer(psb_ipk_) :: debug_level, debug_unit
+    character(len=20)   :: name
+
+    debug_unit  = psb_get_debug_unit()
+    debug_level = psb_get_debug_level()
+
+    if (psb_get_errstatus() /= 0) return 
+    info = psb_success_
+    call psb_erractionsave(err_act)
+    name = 'psb_cdcpy'
+
+    if (desc%is_valid()) then 
+      ictxt = desc%get_context()
+
+      ! check on blacs grid 
+      call psb_info(ictxt, me, np)
+      if (debug_level >= psb_debug_ext_) &
+           & write(debug_unit,*) me,' ',trim(name),': Entered'
+      if (np == -1) then
+        info = psb_err_context_error_
+        call psb_errpush(info,name)
+        goto 9999
+      endif
+
+      desc_out%base_desc  => desc%base_desc
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%halo_index,desc_out%halo_index,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%ext_index,desc_out%ext_index,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%ovrlap_index,&
+           & desc_out%ovrlap_index,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%bnd_elem,desc_out%bnd_elem,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%ovrlap_elem,desc_out%ovrlap_elem,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%ovr_mst_idx,desc_out%ovr_mst_idx,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%lprm,desc_out%lprm,info)
+      if (info == psb_success_)&
+           & call psb_safe_ab_cpy(desc%idx_space,desc_out%idx_space,info)
+!!$      if ((info == psb_success_).and.(allocated(desc%indxmap))) &
+!!$           & call desc%indxmap%clone(desc_out%indxmap,info)
+!!$      associate(indxin => desc%indxmap) 
+!!$        if ((info == psb_success_).and.(allocated(desc%indxmap))) &
+!!$             & call indxin%clone(desc_out%indxmap,info)
+!!$      end associate
+      if ((info == psb_success_).and.(allocated(desc%indxmap))) &
+           & allocate(desc_out%indxmap,source=desc%indxmap,stat=info)
+
+    else
+      call desc_out%free(info)
+    end if
+    if (info /= psb_success_) then
+      info = psb_err_from_subroutine_
+      call psb_errpush(info,name)
+      goto 9999
+    endif
+    if (debug_level >= psb_debug_ext_) &
+         & write(debug_unit,*) me,' ',trim(name),': Done'
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+
+    if (err_act == psb_act_ret_) then
+      return
+    else
+      call psb_error(ictxt)
+    end if
+    return
+
+  end subroutine psb_cd_clone

base/tools/psb_cd_reinit.f90

@@ -68,6 +68,7 @@ Subroutine psb_cd_reinit(desc,info)
   call psb_move_alloc(tmp_ovr,desc%ovrlap_index,info)
   call psb_move_alloc(tmp_halo,desc%halo_index,info)
   call psb_move_alloc(tmp_ext,desc%ext_index,info)
+  call desc%indxmap%reinit(info)
   call psb_cd_set_bld(desc,info)
 
   if (debug_level >= psb_debug_outer_) &