psblas3:

base/modules/psb_c_vect_mod.F90
 base/modules/psb_d_vect_mod.F90
 base/modules/psb_i_vect_mod.F90
 base/modules/psb_s_vect_mod.F90
 base/modules/psb_z_vect_mod.F90
 prec/psb_c_base_prec_mod.f90
 prec/psb_c_bjacprec.f90
 prec/psb_c_diagprec.f90
 prec/psb_c_nullprec.f90
 prec/psb_d_base_prec_mod.f90
 prec/psb_d_bjacprec.f90
 prec/psb_d_diagprec.f90
 prec/psb_d_nullprec.f90
 prec/psb_s_base_prec_mod.f90
 prec/psb_s_bjacprec.f90
 prec/psb_s_diagprec.f90
 prec/psb_s_nullprec.f90
 prec/psb_z_base_prec_mod.f90
 prec/psb_z_bjacprec.f90
 prec/psb_z_diagprec.f90
 prec/psb_z_nullprec.f90


Clone method in base_prec

base/modules/psb_c_vect_mod.F90

@@ -95,11 +95,13 @@ module psb_c_vect_mod
 contains
 
   
-  subroutine c_vect_clone(x,y)
+  subroutine c_vect_clone(x,y,info)
     implicit none 
     class(psb_c_vect_type), intent(inout) :: x
     class(psb_c_vect_type), intent(out)   :: y
+    integer(psb_ipk_), intent(out)        :: info
 
+    info = psb_success_
     if (allocated(x%v)) then 
       call y%bld(x%get_vect(),mold=x%v)
     end if

base/modules/psb_d_vect_mod.F90

@@ -95,11 +95,13 @@ module psb_d_vect_mod
 contains
 
   
-  subroutine d_vect_clone(x,y)
+  subroutine d_vect_clone(x,y,info)
     implicit none 
     class(psb_d_vect_type), intent(inout) :: x
     class(psb_d_vect_type), intent(out)   :: y
+    integer(psb_ipk_), intent(out)        :: info
 
+    info = psb_success_
     if (allocated(x%v)) then 
       call y%bld(x%get_vect(),mold=x%v)
     end if

base/modules/psb_i_vect_mod.F90

@@ -95,11 +95,13 @@ module psb_i_vect_mod
 contains
 
   
-  subroutine i_vect_clone(x,y)
+  subroutine i_vect_clone(x,y,info)
     implicit none 
     class(psb_i_vect_type), intent(inout) :: x
     class(psb_i_vect_type), intent(out)   :: y
+    integer(psb_ipk_), intent(out)        :: info
 
+    info = psb_success_
     if (allocated(x%v)) then 
       call y%bld(x%get_vect(),mold=x%v)
     end if

base/modules/psb_s_vect_mod.F90

@@ -95,11 +95,13 @@ module psb_s_vect_mod
 contains
 
   
-  subroutine s_vect_clone(x,y)
+  subroutine s_vect_clone(x,y,info)
     implicit none 
     class(psb_s_vect_type), intent(inout) :: x
     class(psb_s_vect_type), intent(out)   :: y
+    integer(psb_ipk_), intent(out)        :: info
 
+    info = psb_success_
     if (allocated(x%v)) then 
       call y%bld(x%get_vect(),mold=x%v)
     end if

base/modules/psb_z_vect_mod.F90

@@ -95,11 +95,13 @@ module psb_z_vect_mod
 contains
 
   
-  subroutine z_vect_clone(x,y)
+  subroutine z_vect_clone(x,y,info)
     implicit none 
     class(psb_z_vect_type), intent(inout) :: x
     class(psb_z_vect_type), intent(out)   :: y
+    integer(psb_ipk_), intent(out)        :: info
 
+    info = psb_success_
     if (allocated(x%v)) then 
       call y%bld(x%get_vect(),mold=x%v)
     end if

prec/psb_c_base_prec_mod.f90

@@ -64,6 +64,7 @@ module psb_c_base_prec_mod
     procedure(psb_c_base_precfree), pass(prec), deferred :: precfree   
     procedure(psb_c_base_precdescr), pass(prec), deferred :: precdescr  
     procedure(psb_c_base_precdump), pass(prec), deferred :: dump       
+    procedure(psb_c_base_precclone), pass(prec), deferred :: clone       
   end type psb_c_base_prec_type
 
   private :: psb_c_base_set_ctxt, psb_c_base_get_ctxt, &
@@ -180,6 +181,18 @@ module psb_c_base_prec_mod
     end subroutine psb_c_base_precdump
   end interface
  
+  abstract interface   
+    subroutine psb_c_base_precclone(prec,precout,info)
+      import psb_ipk_, psb_spk_, psb_desc_type, psb_c_vect_type, &
+           & psb_c_base_vect_type, psb_cspmat_type, psb_c_base_prec_type,&
+           & psb_c_base_sparse_mat
+      implicit none 
+      class(psb_c_base_prec_type), intent(inout) :: prec
+      class(psb_c_base_prec_type), allocatable, intent(out) :: precout
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_c_base_precclone
+  end interface
+
 contains
 
   subroutine psb_c_base_precseti(prec,what,val,info)

prec/psb_c_bjacprec.f90

@@ -43,11 +43,12 @@ module psb_c_bjacprec
     procedure, pass(prec) :: precbld   => psb_c_bjac_precbld
     procedure, pass(prec) :: precinit  => psb_c_bjac_precinit
     procedure, pass(prec) :: precseti  => psb_c_bjac_precseti
-    procedure, pass(prec) :: precsetr  => psb_c_bjac_precsetr
+!!$    procedure, pass(prec) :: precsetr  => psb_c_bjac_precsetr
-    procedure, pass(prec) :: precsetc  => psb_c_bjac_precsetc
+!!$    procedure, pass(prec) :: precsetc  => psb_c_bjac_precsetc
     procedure, pass(prec) :: precfree  => psb_c_bjac_precfree
     procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr
     procedure, pass(prec) :: dump      => psb_c_bjac_dump
+    procedure, pass(prec) :: clone     => psb_c_bjac_clone
     procedure, pass(prec) :: sizeof    => psb_c_bjac_sizeof
     procedure, pass(prec) :: get_nzeros => psb_c_bjac_get_nzeros
   end type psb_c_bjac_prec_type
@@ -210,48 +211,33 @@ contains
   end function psb_c_bjac_get_nzeros
 
 
-  subroutine psb_c_bjac_precsetr(prec,what,val,info)
+  subroutine psb_c_bjac_precfree(prec,info)
 
     Implicit None
 
     class(psb_c_bjac_prec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(in)                      :: what 
-    real(psb_spk_), intent(in)               :: val 
     integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='c_bjac_precset'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_c_bjac_precsetr
-
-  subroutine psb_c_bjac_precsetc(prec,what,val,info)
-
-    Implicit None
 
-    class(psb_c_bjac_prec_type),intent(inout) :: prec
+    integer(psb_ipk_) :: err_act, i
-    integer(psb_ipk_), intent(in)                      :: what 
+    character(len=20)  :: name='c_bjac_precfree'
-    character(len=*), intent(in)             :: val
-    integer(psb_ipk_), intent(out)                     :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='c_bjac_precset'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    if (allocated(prec%av)) then 
+      do i=1,size(prec%av) 
+        call prec%av(i)%free()
+      enddo
+      deallocate(prec%av,stat=info)
+    end if
 
+    if (allocated(prec%dv)) then 
+      call prec%dv%free(info)
+      if (info == 0) deallocate(prec%dv,stat=info)
+    end if
+    if (allocated(prec%iprcparm)) then 
+      deallocate(prec%iprcparm,stat=info)
+    end if
     call psb_erractionrestore(err_act)
     return
 
@@ -262,35 +248,49 @@ contains
       return
     end if
     return
-  end subroutine psb_c_bjac_precsetc
 
-  subroutine psb_c_bjac_precfree(prec,info)
+  end subroutine psb_c_bjac_precfree
+
 
+  subroutine psb_c_bjac_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
     Implicit None
 
     class(psb_c_bjac_prec_type), intent(inout) :: prec
+    class(psb_c_base_prec_type), allocatable, intent(out)  :: precout
     integer(psb_ipk_), intent(out)               :: info
 
     integer(psb_ipk_) :: err_act, i
-    character(len=20)  :: name='c_bjac_precfree'
+    character(len=20)  :: name='c_bjac_clone'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    allocate(psb_c_bjac_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_c_bjac_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
       if (allocated(prec%av)) then 
+        allocate(pout%av(size(prec%av)),stat=info)
         do i=1,size(prec%av) 
-        call prec%av(i)%free()
+          if (info /= psb_success_) exit
+          call prec%av(i)%clone(pout%av(i),info)
         enddo
-      deallocate(prec%av,stat=info)
+        if (info /= psb_success_) goto 9999
       end if
 
       if (allocated(prec%dv)) then 
-      call prec%dv%free(info)
+        allocate(pout%dv,stat=info)
-      if (info == 0) deallocate(prec%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
-    end if
-    if (allocated(prec%iprcparm)) then 
-      deallocate(prec%iprcparm,stat=info)
       end if
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
     call psb_erractionrestore(err_act)
     return
 
@@ -302,6 +302,6 @@ contains
     end if
     return
 
-  end subroutine psb_c_bjac_precfree
+  end subroutine psb_c_bjac_clone
 
 end module psb_c_bjacprec

prec/psb_c_diagprec.f90

@@ -45,6 +45,7 @@ module psb_c_diagprec
     procedure, pass(prec) :: precdescr  => psb_c_diag_precdescr
     procedure, pass(prec) :: sizeof     => psb_c_diag_sizeof
     procedure, pass(prec) :: dump       => psb_c_diag_dump
+    procedure, pass(prec) :: clone      => psb_c_diag_clone
     procedure, pass(prec) :: get_nzeros => psb_c_diag_get_nzeros
   end type psb_c_diag_prec_type
 
@@ -225,4 +226,50 @@ contains
   end function psb_c_diag_get_nzeros
 
 
+  subroutine psb_c_diag_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
+
+    Implicit None
+
+    class(psb_c_diag_prec_type), intent(inout) :: prec
+    class(psb_c_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='c_diag_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_c_diag_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_c_diag_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+      if (allocated(prec%dv)) then 
+        allocate(pout%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
+      end if
+      if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_c_diag_clone
+
+
 end module psb_c_diagprec

prec/psb_c_nullprec.f90

@@ -43,6 +43,7 @@ module psb_c_nullprec
     procedure, pass(prec) :: precdescr => psb_c_null_precdescr
     procedure, pass(prec) :: sizeof    => psb_c_null_sizeof
     procedure, pass(prec) :: dump      => psb_c_null_dump
+    procedure, pass(prec) :: clone     => psb_c_null_clone
   end type psb_c_null_prec_type
 
   private :: psb_c_null_precbld, psb_c_null_sizeof,&
@@ -258,4 +259,46 @@ contains
     return
   end function psb_c_null_sizeof
 
+
+  subroutine psb_c_null_clone(prec,precout,info)
+    use psb_const_mod
+    use psb_error_mod
+
+    Implicit None
+
+    class(psb_c_null_prec_type), intent(inout) :: prec
+    class(psb_c_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='c_null_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_c_null_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_c_null_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_c_null_clone
+
+
 end module psb_c_nullprec

prec/psb_d_base_prec_mod.f90

@@ -64,6 +64,7 @@ module psb_d_base_prec_mod
     procedure(psb_d_base_precfree), pass(prec), deferred :: precfree   
     procedure(psb_d_base_precdescr), pass(prec), deferred :: precdescr  
     procedure(psb_d_base_precdump), pass(prec), deferred :: dump       
+    procedure(psb_d_base_precclone), pass(prec), deferred :: clone       
   end type psb_d_base_prec_type
 
   private :: psb_d_base_set_ctxt, psb_d_base_get_ctxt, &
@@ -180,6 +181,18 @@ module psb_d_base_prec_mod
     end subroutine psb_d_base_precdump
   end interface
  
+  abstract interface   
+    subroutine psb_d_base_precclone(prec,precout,info)
+      import psb_ipk_, psb_dpk_, psb_desc_type, psb_d_vect_type, &
+           & psb_d_base_vect_type, psb_dspmat_type, psb_d_base_prec_type,&
+           & psb_d_base_sparse_mat
+      implicit none 
+      class(psb_d_base_prec_type), intent(inout) :: prec
+      class(psb_d_base_prec_type), allocatable, intent(out) :: precout
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_d_base_precclone
+  end interface
+
 contains
 
   subroutine psb_d_base_precseti(prec,what,val,info)

prec/psb_d_bjacprec.f90

@@ -43,11 +43,12 @@ module psb_d_bjacprec
     procedure, pass(prec) :: precbld   => psb_d_bjac_precbld
     procedure, pass(prec) :: precinit  => psb_d_bjac_precinit
     procedure, pass(prec) :: precseti  => psb_d_bjac_precseti
-    procedure, pass(prec) :: precsetr  => psb_d_bjac_precsetr
+!!$    procedure, pass(prec) :: precsetr  => psb_d_bjac_precsetr
-    procedure, pass(prec) :: precsetc  => psb_d_bjac_precsetc
+!!$    procedure, pass(prec) :: precsetc  => psb_d_bjac_precsetc
     procedure, pass(prec) :: precfree  => psb_d_bjac_precfree
     procedure, pass(prec) :: precdescr => psb_d_bjac_precdescr
     procedure, pass(prec) :: dump      => psb_d_bjac_dump
+    procedure, pass(prec) :: clone     => psb_d_bjac_clone
     procedure, pass(prec) :: sizeof    => psb_d_bjac_sizeof
     procedure, pass(prec) :: get_nzeros => psb_d_bjac_get_nzeros
   end type psb_d_bjac_prec_type
@@ -210,48 +211,33 @@ contains
   end function psb_d_bjac_get_nzeros
 
 
-  subroutine psb_d_bjac_precsetr(prec,what,val,info)
+  subroutine psb_d_bjac_precfree(prec,info)
 
     Implicit None
 
     class(psb_d_bjac_prec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(in)                      :: what 
-    real(psb_dpk_), intent(in)               :: val 
     integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='d_bjac_precset'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_d_bjac_precsetr
-
-  subroutine psb_d_bjac_precsetc(prec,what,val,info)
-
-    Implicit None
 
-    class(psb_d_bjac_prec_type),intent(inout) :: prec
+    integer(psb_ipk_) :: err_act, i
-    integer(psb_ipk_), intent(in)                      :: what 
+    character(len=20)  :: name='d_bjac_precfree'
-    character(len=*), intent(in)             :: val
-    integer(psb_ipk_), intent(out)                     :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='d_bjac_precset'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    if (allocated(prec%av)) then 
+      do i=1,size(prec%av) 
+        call prec%av(i)%free()
+      enddo
+      deallocate(prec%av,stat=info)
+    end if
 
+    if (allocated(prec%dv)) then 
+      call prec%dv%free(info)
+      if (info == 0) deallocate(prec%dv,stat=info)
+    end if
+    if (allocated(prec%iprcparm)) then 
+      deallocate(prec%iprcparm,stat=info)
+    end if
     call psb_erractionrestore(err_act)
     return
 
@@ -262,35 +248,49 @@ contains
       return
     end if
     return
-  end subroutine psb_d_bjac_precsetc
 
-  subroutine psb_d_bjac_precfree(prec,info)
+  end subroutine psb_d_bjac_precfree
+
 
+  subroutine psb_d_bjac_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
     Implicit None
 
     class(psb_d_bjac_prec_type), intent(inout) :: prec
+    class(psb_d_base_prec_type), allocatable, intent(out)  :: precout
     integer(psb_ipk_), intent(out)               :: info
 
     integer(psb_ipk_) :: err_act, i
-    character(len=20)  :: name='d_bjac_precfree'
+    character(len=20)  :: name='d_bjac_clone'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    allocate(psb_d_bjac_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_d_bjac_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
       if (allocated(prec%av)) then 
+        allocate(pout%av(size(prec%av)),stat=info)
         do i=1,size(prec%av) 
-        call prec%av(i)%free()
+          if (info /= psb_success_) exit
+          call prec%av(i)%clone(pout%av(i),info)
         enddo
-      deallocate(prec%av,stat=info)
+        if (info /= psb_success_) goto 9999
       end if
 
       if (allocated(prec%dv)) then 
-      call prec%dv%free(info)
+        allocate(pout%dv,stat=info)
-      if (info == 0) deallocate(prec%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
-    end if
-    if (allocated(prec%iprcparm)) then 
-      deallocate(prec%iprcparm,stat=info)
       end if
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
     call psb_erractionrestore(err_act)
     return
 
@@ -302,6 +302,6 @@ contains
     end if
     return
 
-  end subroutine psb_d_bjac_precfree
+  end subroutine psb_d_bjac_clone
 
 end module psb_d_bjacprec

prec/psb_d_diagprec.f90

@@ -45,6 +45,7 @@ module psb_d_diagprec
     procedure, pass(prec) :: precdescr  => psb_d_diag_precdescr
     procedure, pass(prec) :: sizeof     => psb_d_diag_sizeof
     procedure, pass(prec) :: dump       => psb_d_diag_dump
+    procedure, pass(prec) :: clone      => psb_d_diag_clone
     procedure, pass(prec) :: get_nzeros => psb_d_diag_get_nzeros
   end type psb_d_diag_prec_type
 
@@ -225,4 +226,50 @@ contains
   end function psb_d_diag_get_nzeros
 
 
+  subroutine psb_d_diag_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
+
+    Implicit None
+
+    class(psb_d_diag_prec_type), intent(inout) :: prec
+    class(psb_d_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='d_diag_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_d_diag_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_d_diag_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+      if (allocated(prec%dv)) then 
+        allocate(pout%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
+      end if
+      if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_d_diag_clone
+
+
 end module psb_d_diagprec

prec/psb_d_nullprec.f90

@@ -43,6 +43,7 @@ module psb_d_nullprec
     procedure, pass(prec) :: precdescr => psb_d_null_precdescr
     procedure, pass(prec) :: sizeof    => psb_d_null_sizeof
     procedure, pass(prec) :: dump      => psb_d_null_dump
+    procedure, pass(prec) :: clone     => psb_d_null_clone
   end type psb_d_null_prec_type
 
   private :: psb_d_null_precbld, psb_d_null_sizeof,&
@@ -258,4 +259,46 @@ contains
     return
   end function psb_d_null_sizeof
 
+
+  subroutine psb_d_null_clone(prec,precout,info)
+    use psb_const_mod
+    use psb_error_mod
+
+    Implicit None
+
+    class(psb_d_null_prec_type), intent(inout) :: prec
+    class(psb_d_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='d_null_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_d_null_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_d_null_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_d_null_clone
+
+
 end module psb_d_nullprec

prec/psb_s_base_prec_mod.f90

@@ -64,6 +64,7 @@ module psb_s_base_prec_mod
     procedure(psb_s_base_precfree), pass(prec), deferred :: precfree   
     procedure(psb_s_base_precdescr), pass(prec), deferred :: precdescr  
     procedure(psb_s_base_precdump), pass(prec), deferred :: dump       
+    procedure(psb_s_base_precclone), pass(prec), deferred :: clone       
   end type psb_s_base_prec_type
 
   private :: psb_s_base_set_ctxt, psb_s_base_get_ctxt, &
@@ -180,6 +181,18 @@ module psb_s_base_prec_mod
     end subroutine psb_s_base_precdump
   end interface
  
+  abstract interface   
+    subroutine psb_s_base_precclone(prec,precout,info)
+      import psb_ipk_, psb_spk_, psb_desc_type, psb_s_vect_type, &
+           & psb_s_base_vect_type, psb_sspmat_type, psb_s_base_prec_type,&
+           & psb_s_base_sparse_mat
+      implicit none 
+      class(psb_s_base_prec_type), intent(inout) :: prec
+      class(psb_s_base_prec_type), allocatable, intent(out) :: precout
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_s_base_precclone
+  end interface
+
 contains
 
   subroutine psb_s_base_precseti(prec,what,val,info)

prec/psb_s_bjacprec.f90

@@ -43,11 +43,12 @@ module psb_s_bjacprec
     procedure, pass(prec) :: precbld   => psb_s_bjac_precbld
     procedure, pass(prec) :: precinit  => psb_s_bjac_precinit
     procedure, pass(prec) :: precseti  => psb_s_bjac_precseti
-    procedure, pass(prec) :: precsetr  => psb_s_bjac_precsetr
+!!$    procedure, pass(prec) :: precsetr  => psb_s_bjac_precsetr
-    procedure, pass(prec) :: precsetc  => psb_s_bjac_precsetc
+!!$    procedure, pass(prec) :: precsetc  => psb_s_bjac_precsetc
     procedure, pass(prec) :: precfree  => psb_s_bjac_precfree
     procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr
     procedure, pass(prec) :: dump      => psb_s_bjac_dump
+    procedure, pass(prec) :: clone     => psb_s_bjac_clone
     procedure, pass(prec) :: sizeof    => psb_s_bjac_sizeof
     procedure, pass(prec) :: get_nzeros => psb_s_bjac_get_nzeros
   end type psb_s_bjac_prec_type
@@ -210,48 +211,33 @@ contains
   end function psb_s_bjac_get_nzeros
 
 
-  subroutine psb_s_bjac_precsetr(prec,what,val,info)
+  subroutine psb_s_bjac_precfree(prec,info)
 
     Implicit None
 
     class(psb_s_bjac_prec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(in)                      :: what 
-    real(psb_spk_), intent(in)               :: val 
     integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='s_bjac_precset'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_s_bjac_precsetr
-
-  subroutine psb_s_bjac_precsetc(prec,what,val,info)
-
-    Implicit None
 
-    class(psb_s_bjac_prec_type),intent(inout) :: prec
+    integer(psb_ipk_) :: err_act, i
-    integer(psb_ipk_), intent(in)                      :: what 
+    character(len=20)  :: name='s_bjac_precfree'
-    character(len=*), intent(in)             :: val
-    integer(psb_ipk_), intent(out)                     :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='s_bjac_precset'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    if (allocated(prec%av)) then 
+      do i=1,size(prec%av) 
+        call prec%av(i)%free()
+      enddo
+      deallocate(prec%av,stat=info)
+    end if
 
+    if (allocated(prec%dv)) then 
+      call prec%dv%free(info)
+      if (info == 0) deallocate(prec%dv,stat=info)
+    end if
+    if (allocated(prec%iprcparm)) then 
+      deallocate(prec%iprcparm,stat=info)
+    end if
     call psb_erractionrestore(err_act)
     return
 
@@ -262,35 +248,49 @@ contains
       return
     end if
     return
-  end subroutine psb_s_bjac_precsetc
 
-  subroutine psb_s_bjac_precfree(prec,info)
+  end subroutine psb_s_bjac_precfree
+
 
+  subroutine psb_s_bjac_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
     Implicit None
 
     class(psb_s_bjac_prec_type), intent(inout) :: prec
+    class(psb_s_base_prec_type), allocatable, intent(out)  :: precout
     integer(psb_ipk_), intent(out)               :: info
 
     integer(psb_ipk_) :: err_act, i
-    character(len=20)  :: name='s_bjac_precfree'
+    character(len=20)  :: name='s_bjac_clone'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    allocate(psb_s_bjac_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_s_bjac_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
       if (allocated(prec%av)) then 
+        allocate(pout%av(size(prec%av)),stat=info)
         do i=1,size(prec%av) 
-        call prec%av(i)%free()
+          if (info /= psb_success_) exit
+          call prec%av(i)%clone(pout%av(i),info)
         enddo
-      deallocate(prec%av,stat=info)
+        if (info /= psb_success_) goto 9999
       end if
 
       if (allocated(prec%dv)) then 
-      call prec%dv%free(info)
+        allocate(pout%dv,stat=info)
-      if (info == 0) deallocate(prec%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
-    end if
-    if (allocated(prec%iprcparm)) then 
-      deallocate(prec%iprcparm,stat=info)
       end if
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
     call psb_erractionrestore(err_act)
     return
 
@@ -302,6 +302,6 @@ contains
     end if
     return
 
-  end subroutine psb_s_bjac_precfree
+  end subroutine psb_s_bjac_clone
 
 end module psb_s_bjacprec

prec/psb_s_diagprec.f90

@@ -45,6 +45,7 @@ module psb_s_diagprec
     procedure, pass(prec) :: precdescr  => psb_s_diag_precdescr
     procedure, pass(prec) :: sizeof     => psb_s_diag_sizeof
     procedure, pass(prec) :: dump       => psb_s_diag_dump
+    procedure, pass(prec) :: clone      => psb_s_diag_clone
     procedure, pass(prec) :: get_nzeros => psb_s_diag_get_nzeros
   end type psb_s_diag_prec_type
 
@@ -225,4 +226,50 @@ contains
   end function psb_s_diag_get_nzeros
 
 
+  subroutine psb_s_diag_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
+
+    Implicit None
+
+    class(psb_s_diag_prec_type), intent(inout) :: prec
+    class(psb_s_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='s_diag_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_s_diag_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_s_diag_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+      if (allocated(prec%dv)) then 
+        allocate(pout%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
+      end if
+      if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_s_diag_clone
+
+
 end module psb_s_diagprec

prec/psb_s_nullprec.f90

@@ -43,6 +43,7 @@ module psb_s_nullprec
     procedure, pass(prec) :: precdescr => psb_s_null_precdescr
     procedure, pass(prec) :: sizeof    => psb_s_null_sizeof
     procedure, pass(prec) :: dump      => psb_s_null_dump
+    procedure, pass(prec) :: clone     => psb_s_null_clone
   end type psb_s_null_prec_type
 
   private :: psb_s_null_precbld, psb_s_null_sizeof,&
@@ -258,4 +259,46 @@ contains
     return
   end function psb_s_null_sizeof
 
+
+  subroutine psb_s_null_clone(prec,precout,info)
+    use psb_const_mod
+    use psb_error_mod
+
+    Implicit None
+
+    class(psb_s_null_prec_type), intent(inout) :: prec
+    class(psb_s_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='s_null_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_s_null_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_s_null_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_s_null_clone
+
+
 end module psb_s_nullprec

prec/psb_z_base_prec_mod.f90

@@ -64,6 +64,7 @@ module psb_z_base_prec_mod
     procedure(psb_z_base_precfree), pass(prec), deferred :: precfree   
     procedure(psb_z_base_precdescr), pass(prec), deferred :: precdescr  
     procedure(psb_z_base_precdump), pass(prec), deferred :: dump       
+    procedure(psb_z_base_precclone), pass(prec), deferred :: clone       
   end type psb_z_base_prec_type
 
   private :: psb_z_base_set_ctxt, psb_z_base_get_ctxt, &
@@ -180,6 +181,18 @@ module psb_z_base_prec_mod
     end subroutine psb_z_base_precdump
   end interface
  
+  abstract interface   
+    subroutine psb_z_base_precclone(prec,precout,info)
+      import psb_ipk_, psb_dpk_, psb_desc_type, psb_z_vect_type, &
+           & psb_z_base_vect_type, psb_zspmat_type, psb_z_base_prec_type,&
+           & psb_z_base_sparse_mat
+      implicit none 
+      class(psb_z_base_prec_type), intent(inout) :: prec
+      class(psb_z_base_prec_type), allocatable, intent(out) :: precout
+      integer(psb_ipk_), intent(out)               :: info
+    end subroutine psb_z_base_precclone
+  end interface
+
 contains
 
   subroutine psb_z_base_precseti(prec,what,val,info)

prec/psb_z_bjacprec.f90

@@ -43,11 +43,12 @@ module psb_z_bjacprec
     procedure, pass(prec) :: precbld   => psb_z_bjac_precbld
     procedure, pass(prec) :: precinit  => psb_z_bjac_precinit
     procedure, pass(prec) :: precseti  => psb_z_bjac_precseti
-    procedure, pass(prec) :: precsetr  => psb_z_bjac_precsetr
+!!$    procedure, pass(prec) :: precsetr  => psb_z_bjac_precsetr
-    procedure, pass(prec) :: precsetc  => psb_z_bjac_precsetc
+!!$    procedure, pass(prec) :: precsetc  => psb_z_bjac_precsetc
     procedure, pass(prec) :: precfree  => psb_z_bjac_precfree
     procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr
     procedure, pass(prec) :: dump      => psb_z_bjac_dump
+    procedure, pass(prec) :: clone     => psb_z_bjac_clone
     procedure, pass(prec) :: sizeof    => psb_z_bjac_sizeof
     procedure, pass(prec) :: get_nzeros => psb_z_bjac_get_nzeros
   end type psb_z_bjac_prec_type
@@ -210,48 +211,33 @@ contains
   end function psb_z_bjac_get_nzeros
 
 
-  subroutine psb_z_bjac_precsetr(prec,what,val,info)
+  subroutine psb_z_bjac_precfree(prec,info)
 
     Implicit None
 
     class(psb_z_bjac_prec_type), intent(inout) :: prec
-    integer(psb_ipk_), intent(in)                      :: what 
-    real(psb_dpk_), intent(in)               :: val 
     integer(psb_ipk_), intent(out)                :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='z_bjac_precset'
-
-    call psb_erractionsave(err_act)
-
-    info = psb_success_
-
-    call psb_erractionrestore(err_act)
-    return
-
-9999 continue
-    call psb_erractionrestore(err_act)
-    if (err_act == psb_act_abort_) then
-      call psb_error()
-      return
-    end if
-    return
-  end subroutine psb_z_bjac_precsetr
-
-  subroutine psb_z_bjac_precsetc(prec,what,val,info)
-
-    Implicit None
 
-    class(psb_z_bjac_prec_type),intent(inout) :: prec
+    integer(psb_ipk_) :: err_act, i
-    integer(psb_ipk_), intent(in)                      :: what 
+    character(len=20)  :: name='z_bjac_precfree'
-    character(len=*), intent(in)             :: val
-    integer(psb_ipk_), intent(out)                     :: info
-    integer(psb_ipk_) :: err_act, nrow
-    character(len=20)  :: name='z_bjac_precset'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    if (allocated(prec%av)) then 
+      do i=1,size(prec%av) 
+        call prec%av(i)%free()
+      enddo
+      deallocate(prec%av,stat=info)
+    end if
 
+    if (allocated(prec%dv)) then 
+      call prec%dv%free(info)
+      if (info == 0) deallocate(prec%dv,stat=info)
+    end if
+    if (allocated(prec%iprcparm)) then 
+      deallocate(prec%iprcparm,stat=info)
+    end if
     call psb_erractionrestore(err_act)
     return
 
@@ -262,35 +248,49 @@ contains
       return
     end if
     return
-  end subroutine psb_z_bjac_precsetc
 
-  subroutine psb_z_bjac_precfree(prec,info)
+  end subroutine psb_z_bjac_precfree
+
 
+  subroutine psb_z_bjac_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
     Implicit None
 
     class(psb_z_bjac_prec_type), intent(inout) :: prec
+    class(psb_z_base_prec_type), allocatable, intent(out)  :: precout
     integer(psb_ipk_), intent(out)               :: info
 
     integer(psb_ipk_) :: err_act, i
-    character(len=20)  :: name='z_bjac_precfree'
+    character(len=20)  :: name='z_bjac_clone'
 
     call psb_erractionsave(err_act)
 
     info = psb_success_
+    allocate(psb_z_bjac_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_z_bjac_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
       if (allocated(prec%av)) then 
+        allocate(pout%av(size(prec%av)),stat=info)
         do i=1,size(prec%av) 
-        call prec%av(i)%free()
+          if (info /= psb_success_) exit
+          call prec%av(i)%clone(pout%av(i),info)
         enddo
-      deallocate(prec%av,stat=info)
+        if (info /= psb_success_) goto 9999
       end if
 
       if (allocated(prec%dv)) then 
-      call prec%dv%free(info)
+        allocate(pout%dv,stat=info)
-      if (info == 0) deallocate(prec%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
-    end if
-    if (allocated(prec%iprcparm)) then 
-      deallocate(prec%iprcparm,stat=info)
       end if
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
     call psb_erractionrestore(err_act)
     return
 
@@ -302,6 +302,6 @@ contains
     end if
     return
 
-  end subroutine psb_z_bjac_precfree
+  end subroutine psb_z_bjac_clone
 
 end module psb_z_bjacprec

prec/psb_z_diagprec.f90

@@ -45,6 +45,7 @@ module psb_z_diagprec
     procedure, pass(prec) :: precdescr  => psb_z_diag_precdescr
     procedure, pass(prec) :: sizeof     => psb_z_diag_sizeof
     procedure, pass(prec) :: dump       => psb_z_diag_dump
+    procedure, pass(prec) :: clone      => psb_z_diag_clone
     procedure, pass(prec) :: get_nzeros => psb_z_diag_get_nzeros
   end type psb_z_diag_prec_type
 
@@ -225,4 +226,50 @@ contains
   end function psb_z_diag_get_nzeros
 
 
+  subroutine psb_z_diag_clone(prec,precout,info)
+    use psb_error_mod
+    use psb_realloc_mod
+
+    Implicit None
+
+    class(psb_z_diag_prec_type), intent(inout) :: prec
+    class(psb_z_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='z_diag_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_z_diag_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_z_diag_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+      if (allocated(prec%dv)) then 
+        allocate(pout%dv,stat=info)
+        if (info == 0) call prec%dv%clone(pout%dv,info)
+      end if
+      if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_z_diag_clone
+
+
 end module psb_z_diagprec

prec/psb_z_nullprec.f90

@@ -43,6 +43,7 @@ module psb_z_nullprec
     procedure, pass(prec) :: precdescr => psb_z_null_precdescr
     procedure, pass(prec) :: sizeof    => psb_z_null_sizeof
     procedure, pass(prec) :: dump      => psb_z_null_dump
+    procedure, pass(prec) :: clone     => psb_z_null_clone
   end type psb_z_null_prec_type
 
   private :: psb_z_null_precbld, psb_z_null_sizeof,&
@@ -258,4 +259,46 @@ contains
     return
   end function psb_z_null_sizeof
 
+
+  subroutine psb_z_null_clone(prec,precout,info)
+    use psb_const_mod
+    use psb_error_mod
+
+    Implicit None
+
+    class(psb_z_null_prec_type), intent(inout) :: prec
+    class(psb_z_base_prec_type), allocatable, intent(out)  :: precout
+    integer(psb_ipk_), intent(out)               :: info
+
+    integer(psb_ipk_) :: err_act, i
+    character(len=20)  :: name='z_null_clone'
+
+    call psb_erractionsave(err_act)
+
+    info = psb_success_
+    allocate(psb_z_null_prec_type :: precout, stat=info)
+    if (info /= 0) goto 9999
+    select type(pout => precout)
+    type is (psb_z_null_prec_type) 
+      call pout%set_ctxt(prec%get_ctxt())
+
+    class default
+      info = psb_err_internal_error_
+    end select
+    if (info /= 0) goto 9999
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 continue
+    call psb_erractionrestore(err_act)
+    if (err_act == psb_act_abort_) then
+      call psb_error()
+      return
+    end if
+    return
+
+  end subroutine psb_z_null_clone
+
+
 end module psb_z_nullprec