psblsa3-dev:

base/modules/psb_gen_block_map_mod.f03
 base/modules/psb_glist_map_mod.f03
 base/modules/psb_hash_map_mod.f03
 base/modules/psb_indx_map_mod.f03
 base/modules/psb_list_map_mod.f03
 base/modules/psb_repl_map_mod.f03
 base/tools/psb_cdcpy.f90

Defined CLONE method in indx_map. Use it to work around GNU PR 47085. 
TBD: move under IFDEF

base/modules/psb_gen_block_map_mod.f03

@@ -61,6 +61,7 @@ module psb_gen_block_map_mod
     procedure, pass(idxmap)  :: sizeof    => block_sizeof
     procedure, pass(idxmap)  :: asb       => block_asb
     procedure, pass(idxmap)  :: free      => block_free
+    procedure, pass(idxmap)  :: clone     => block_clone
     procedure, pass(idxmap)  :: get_fmt   => block_get_fmt
 
     procedure, pass(idxmap)  :: l2gs1 => block_l2gs1
@@ -86,7 +87,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_g2lv1_ins, block_g2lv2_ins, block_clone
 
 
 contains
@@ -669,4 +670,66 @@ contains
     res = 'BLOCK'
   end function block_get_fmt
 
+
+  subroutine block_clone(idxmap,outmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_gen_block_map), intent(in)    :: idxmap
+    class(psb_indx_map), allocatable, intent(out) :: outmap
+    integer, intent(out) :: info
+    Integer :: err_act
+    character(len=20)  :: name='block_clone'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+    if (allocated(outmap)) then 
+      write(0,*) 'Error: should not be allocated on input'
+      info = -87
+      goto 9999
+    end if
+    
+    allocate(psb_gen_block_map :: outmap, stat=info) 
+    if (info /= psb_success_) then 
+      info = psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    select type (outmap)
+    type is (psb_gen_block_map) 
+      if (info == psb_success_) then 
+        outmap%psb_indx_map = idxmap%psb_indx_map
+        outmap%min_glob_row = idxmap%min_glob_row
+        outmap%max_glob_row = idxmap%max_glob_row
+      end if
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%loc_to_glob,outmap%loc_to_glob,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%vnl,outmap%vnl,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%srt_l2g,outmap%srt_l2g,info)
+    class default
+      ! This should be impossible 
+      info = -1
+    end select
+      
+    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_clone
+
 end module psb_gen_block_map_mod

base/modules/psb_glist_map_mod.f03

@@ -52,6 +52,7 @@ module psb_glist_map_mod
     procedure, pass(idxmap)  :: glist_map_init   => glist_initvg
     procedure, pass(idxmap)  :: sizeof  => glist_sizeof
     procedure, pass(idxmap)  :: free    => glist_free
+    procedure, pass(idxmap)  :: clone   => glist_clone
     procedure, pass(idxmap)  :: get_fmt => glist_get_fmt
     procedure, pass(idxmap)  :: fnd_owner => glist_fnd_owner
 
@@ -184,4 +185,66 @@ contains
   end function glist_get_fmt
 
 
+
+  subroutine glist_clone(idxmap,outmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_glist_map), intent(in)    :: idxmap
+    class(psb_indx_map), allocatable, intent(out) :: outmap
+    integer, intent(out) :: info
+    Integer :: err_act
+    character(len=20)  :: name='glist_clone'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+    if (allocated(outmap)) then 
+      write(0,*) 'Error: should not be allocated on input'
+      info = -87
+      goto 9999
+    end if
+    
+    allocate(psb_glist_map :: outmap, stat=info) 
+    if (info /= psb_success_) then 
+      info = psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    select type (outmap)
+    type is (psb_glist_map) 
+
+      if (info == psb_success_) then 
+        outmap%psb_indx_map = idxmap%psb_indx_map
+        outmap%pnt_h        = idxmap%pnt_h
+      end if
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%loc_to_glob,outmap%loc_to_glob,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%glob_to_loc,outmap%glob_to_loc,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%vgp,outmap%vgp,info)
+    class default
+      ! This should be impossible 
+      info = -1
+    end select
+      
+    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 glist_clone
+
 end module psb_glist_map_mod

base/modules/psb_hash_map_mod.f03

@@ -72,6 +72,7 @@ contains
   procedure, pass(idxmap)  :: sizeof    => hash_sizeof
   procedure, pass(idxmap)  :: asb       => hash_asb
   procedure, pass(idxmap)  :: free      => hash_free
+  procedure, pass(idxmap)  :: clone     => hash_clone
   procedure, pass(idxmap)  :: get_fmt   => hash_get_fmt
 
   procedure, pass(idxmap)  :: row_extendable => hash_row_extendable
@@ -1241,4 +1242,69 @@ subroutine hash_inner_cnv2(n,x,y,hashmask,hashv,glb_lc,mask,nrm)
 end subroutine hash_inner_cnv2
 
 
+  subroutine hash_clone(idxmap,outmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_hash_map), intent(in)    :: idxmap
+    class(psb_indx_map), allocatable, intent(out) :: outmap
+    integer, intent(out) :: info
+    Integer :: err_act
+    character(len=20)  :: name='hash_clone'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+    if (allocated(outmap)) then 
+      write(0,*) 'Error: should not be allocated on input'
+      info = -87
+      goto 9999
+    end if
+
+    allocate(psb_hash_map :: outmap, stat=info )
+    if (info /= psb_success_) then 
+      info = psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    select type (outmap)
+    type is (psb_hash_map) 
+      if (info == psb_success_) then 
+        outmap%psb_indx_map = idxmap%psb_indx_map
+        outmap%hashvsize    = idxmap%hashvsize
+        outmap%hashvmask    = idxmap%hashvmask
+        allocate(outmap%hash, stat=info) 
+      end if
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%loc_to_glob,outmap%loc_to_glob,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%hashv,outmap%hashv,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%glb_lc,outmap%glb_lc,info)
+      if (info == psb_success_)&
+           &  call psb_hash_copy(idxmap%hash,outmap%hash,info)
+      class default
+        ! This should be impossible 
+      info = -1
+    end select
+
+    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_clone
+
+
 end module psb_hash_map_mod

base/modules/psb_indx_map_mod.f03

@@ -119,6 +119,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)  :: l2gs1  => base_l2gs1
     procedure, pass(idxmap)  :: l2gs2  => base_l2gs2
@@ -154,7 +155,8 @@ module psb_indx_map_mod
        & base_l2gs1, base_l2gs2, base_l2gv1, base_l2gv2,&
        & 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_g2lv2_ins, base_init_vl, base_is_null,&
+       & base_row_extendable, base_clone
 
   interface 
     subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info)
@@ -788,6 +790,30 @@ contains
     return
   end subroutine base_init_vl
 
+  subroutine base_clone(idxmap,outmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    implicit none 
+    class(psb_indx_map), intent(in)    :: idxmap
+    class(psb_indx_map), allocatable, intent(out) :: outmap
+    integer, intent(out) :: info
+    Integer :: err_act
+    character(len=20)  :: name='base_clone'
+    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_clone
 
 end module psb_indx_map_mod

base/modules/psb_list_map_mod.f03

@@ -53,6 +53,7 @@ module psb_list_map_mod
     procedure, pass(idxmap)  :: sizeof    => list_sizeof
     procedure, pass(idxmap)  :: asb       => list_asb
     procedure, pass(idxmap)  :: free      => list_free
+    procedure, pass(idxmap)  :: clone     => list_clone
     procedure, pass(idxmap)  :: get_fmt   => list_get_fmt
     procedure, pass(idxmap)  :: row_extendable => list_row_extendable
 
@@ -631,4 +632,62 @@ contains
   end function list_get_fmt
 
 
+  subroutine list_clone(idxmap,outmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_list_map), intent(in)    :: idxmap
+    class(psb_indx_map), allocatable, intent(out) :: outmap
+    integer, intent(out) :: info
+    Integer :: err_act
+    character(len=20)  :: name='list_clone'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+    if (allocated(outmap)) then 
+      write(0,*) 'Error: should not be allocated on input'
+      info = -87
+      goto 9999
+    end if
+    
+    allocate(psb_list_map :: outmap, stat=info) 
+    if (info /= psb_success_) then 
+      info = psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    select type (outmap)
+    type is (psb_list_map) 
+      if (info == psb_success_) then 
+        outmap%psb_indx_map = idxmap%psb_indx_map
+        outmap%pnt_h        = idxmap%pnt_h
+      end if
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%loc_to_glob,outmap%loc_to_glob,info)
+      if (info == psb_success_)&
+           &  call psb_safe_ab_cpy(idxmap%glob_to_loc,outmap%glob_to_loc,info)
+    class default
+      ! This should be impossible 
+      info = -1
+    end select
+      
+    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 list_clone
+
 end module psb_list_map_mod

base/modules/psb_repl_map_mod.f03

@@ -54,6 +54,7 @@ module psb_repl_map_mod
     procedure, pass(idxmap)  :: is_repl   => repl_is_repl
     procedure, pass(idxmap)  :: asb       => repl_asb
     procedure, pass(idxmap)  :: free      => repl_free
+    procedure, pass(idxmap)  :: clone     => repl_clone
     procedure, pass(idxmap)  :: get_fmt   => repl_get_fmt
 
     procedure, pass(idxmap)  :: l2gs1 => repl_l2gs1
@@ -540,4 +541,55 @@ contains
     res = 'REPL'
   end function repl_get_fmt
 
+
+  subroutine repl_clone(idxmap,outmap,info)
+    use psb_penv_mod
+    use psb_error_mod
+    use psb_realloc_mod
+    implicit none 
+    class(psb_repl_map), intent(in)    :: idxmap
+    class(psb_indx_map), allocatable, intent(out) :: outmap
+    integer, intent(out) :: info
+    Integer :: err_act
+    character(len=20)  :: name='repl_clone'
+    logical, parameter :: debug=.false.
+
+    info = psb_success_
+    call psb_get_erraction(err_act)
+    if (allocated(outmap)) then 
+      write(0,*) 'Error: should not be allocated on input'
+      info = -87
+      goto 9999
+    end if
+    
+    allocate(psb_repl_map :: outmap, stat=info) 
+    if (info /= psb_success_) then 
+      info = psb_err_alloc_dealloc_
+      call psb_errpush(info,name)
+      goto 9999
+    end if
+
+    select type (outmap)
+    type is (psb_repl_map) 
+        outmap%psb_indx_map = idxmap%psb_indx_map
+    class default
+      ! This should be impossible 
+      info = -1
+    end select
+      
+    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 repl_clone
 end module psb_repl_map_mod

base/tools/psb_cdcpy.f90

@@ -85,12 +85,18 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
   if (info == psb_success_) call psb_safe_ab_cpy(desc_in%idx_space,desc_out%idx_space,info)
 
   if (allocated(desc_in%indxmap)) then 
-    if (allocated(desc_out%indxmap)) then 
+!!$    if (allocated(desc_out%indxmap)) then 
-      call desc_out%indxmap%free()
+!!$      ! This should never happen
-      deallocate(desc_out%indxmap)
+!!$      call desc_out%indxmap%free()
-    end if
+!!$      deallocate(desc_out%indxmap)
-    if (info == psb_success_)&
+!!$    end if
-         & allocate(desc_out%indxmap, source=desc_in%indxmap, stat=info) 
+!!$    write(debug_unit,*) me,' ',trim(name),': Calling allocate(SOURCE = )'
+!!$    if (info == psb_success_)&
+!!$         & allocate(desc_out%indxmap, source=desc_in%indxmap, stat=info) 
+    
+    call desc_in%indxmap%clone(desc_out%indxmap,info)
+    
+    
   end if
 
   if (info /= psb_success_) then