From c6881d1926be10f63d392cf4df6f6de76eed52b4 Mon Sep 17 00:00:00 2001
From: Salvatore Filippone <salvatore.filippone@cranfield.ac.uk>
Date: Fri, 5 Apr 2013 14:35:50 +0000
Subject: [PATCH] mld2p4-2: mlprec/impl/smoother/mld_c_as_smoother_clone.f90
mlprec/impl/smoother/mld_c_base_smoother_clone.f90
mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
mlprec/impl/smoother/mld_d_as_smoother_clone.f90
mlprec/impl/smoother/mld_d_base_smoother_clone.f90
mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
mlprec/impl/smoother/mld_s_as_smoother_clone.f90
mlprec/impl/smoother/mld_s_base_smoother_clone.f90
mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
mlprec/impl/smoother/mld_z_as_smoother_clone.f90
mlprec/impl/smoother/mld_z_base_smoother_clone.f90
mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
mlprec/impl/solver/mld_c_base_solver_clone.f90
mlprec/impl/solver/mld_c_diag_solver_clone.f90
mlprec/impl/solver/mld_c_id_solver_clone.f90
mlprec/impl/solver/mld_c_ilu_solver_clone.f90
mlprec/impl/solver/mld_d_base_solver_clone.f90
mlprec/impl/solver/mld_d_diag_solver_clone.f90
mlprec/impl/solver/mld_d_id_solver_clone.f90
mlprec/impl/solver/mld_d_ilu_solver_clone.f90
mlprec/impl/solver/mld_s_base_solver_clone.f90
mlprec/impl/solver/mld_s_diag_solver_clone.f90
mlprec/impl/solver/mld_s_id_solver_clone.f90
mlprec/impl/solver/mld_s_ilu_solver_clone.f90
mlprec/impl/solver/mld_z_base_solver_clone.f90
mlprec/impl/solver/mld_z_diag_solver_clone.f90
mlprec/impl/solver/mld_z_id_solver_clone.f90
mlprec/impl/solver/mld_z_ilu_solver_clone.f90 mlprec/mld_base_prec_type.F90
mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90
mlprec/mld_c_base_solver_mod.f90 mlprec/mld_c_diag_solver.f90
mlprec/mld_c_id_solver.f90 mlprec/mld_c_ilu_solver.f90
mlprec/mld_c_jac_smoother.f90 mlprec/mld_c_onelev_mod.f90
mlprec/mld_c_prec_type.f90 mlprec/mld_d_as_smoother.f90
mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_base_solver_mod.f90
mlprec/mld_d_diag_solver.f90 mlprec/mld_d_id_solver.f90
mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_jac_smoother.f90
mlprec/mld_d_onelev_mod.f90 mlprec/mld_d_prec_type.f90
mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90
mlprec/mld_s_base_solver_mod.f90 mlprec/mld_s_diag_solver.f90
mlprec/mld_s_id_solver.f90 mlprec/mld_s_ilu_solver.f90
mlprec/mld_s_jac_smoother.f90 mlprec/mld_s_onelev_mod.f90
mlprec/mld_s_prec_type.f90 mlprec/mld_z_as_smoother.f90
mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_base_solver_mod.f90
mlprec/mld_z_diag_solver.f90 mlprec/mld_z_id_solver.f90
mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_jac_smoother.f90
mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_prec_type.f90
Fix clone to avoid INTENT(OUT),ALLOCATABLE and use intent(inout)
---
.../impl/smoother/mld_c_as_smoother_clone.f90 | 18 ++++--
.../smoother/mld_c_base_smoother_clone.f90 | 4 +-
.../smoother/mld_c_jac_smoother_clone.f90 | 20 ++++--
.../impl/smoother/mld_d_as_smoother_clone.f90 | 18 ++++--
.../smoother/mld_d_base_smoother_clone.f90 | 4 +-
.../smoother/mld_d_jac_smoother_clone.f90 | 20 ++++--
.../impl/smoother/mld_s_as_smoother_clone.f90 | 18 ++++--
.../smoother/mld_s_base_smoother_clone.f90 | 4 +-
.../smoother/mld_s_jac_smoother_clone.f90 | 20 ++++--
.../impl/smoother/mld_z_as_smoother_clone.f90 | 18 ++++--
.../smoother/mld_z_base_smoother_clone.f90 | 4 +-
.../smoother/mld_z_jac_smoother_clone.f90 | 20 ++++--
.../impl/solver/mld_c_base_solver_clone.f90 | 6 +-
.../impl/solver/mld_c_diag_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_c_id_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_c_ilu_solver_clone.f90 | 15 +++--
.../impl/solver/mld_d_base_solver_clone.f90 | 6 +-
.../impl/solver/mld_d_diag_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_d_id_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_d_ilu_solver_clone.f90 | 15 +++--
.../impl/solver/mld_s_base_solver_clone.f90 | 6 +-
.../impl/solver/mld_s_diag_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_s_id_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_s_ilu_solver_clone.f90 | 15 +++--
.../impl/solver/mld_z_base_solver_clone.f90 | 6 +-
.../impl/solver/mld_z_diag_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_z_id_solver_clone.f90 | 15 +++--
mlprec/impl/solver/mld_z_ilu_solver_clone.f90 | 15 +++--
mlprec/mld_base_prec_type.F90 | 8 +--
mlprec/mld_c_as_smoother.f90 | 15 ++++-
mlprec/mld_c_base_smoother_mod.f90 | 13 +++-
mlprec/mld_c_base_solver_mod.f90 | 17 +++--
mlprec/mld_c_diag_solver.f90 | 18 ++++--
mlprec/mld_c_id_solver.f90 | 17 +++--
mlprec/mld_c_ilu_solver.f90 | 17 +++--
mlprec/mld_c_jac_smoother.f90 | 15 ++++-
mlprec/mld_c_onelev_mod.f90 | 13 +++-
mlprec/mld_c_prec_type.f90 | 63 ++++++++++++-------
mlprec/mld_d_as_smoother.f90 | 15 ++++-
mlprec/mld_d_base_smoother_mod.f90 | 13 +++-
mlprec/mld_d_base_solver_mod.f90 | 17 +++--
mlprec/mld_d_diag_solver.f90 | 18 ++++--
mlprec/mld_d_id_solver.f90 | 17 +++--
mlprec/mld_d_ilu_solver.f90 | 17 +++--
mlprec/mld_d_jac_smoother.f90 | 15 ++++-
mlprec/mld_d_onelev_mod.f90 | 13 +++-
mlprec/mld_d_prec_type.f90 | 63 ++++++++++++-------
mlprec/mld_s_as_smoother.f90 | 15 ++++-
mlprec/mld_s_base_smoother_mod.f90 | 13 +++-
mlprec/mld_s_base_solver_mod.f90 | 17 +++--
mlprec/mld_s_diag_solver.f90 | 18 ++++--
mlprec/mld_s_id_solver.f90 | 17 +++--
mlprec/mld_s_ilu_solver.f90 | 17 +++--
mlprec/mld_s_jac_smoother.f90 | 15 ++++-
mlprec/mld_s_onelev_mod.f90 | 13 +++-
mlprec/mld_s_prec_type.f90 | 63 ++++++++++++-------
mlprec/mld_z_as_smoother.f90 | 15 ++++-
mlprec/mld_z_base_smoother_mod.f90 | 13 +++-
mlprec/mld_z_base_solver_mod.f90 | 17 +++--
mlprec/mld_z_diag_solver.f90 | 18 ++++--
mlprec/mld_z_id_solver.f90 | 17 +++--
mlprec/mld_z_ilu_solver.f90 | 17 +++--
mlprec/mld_z_jac_smoother.f90 | 15 ++++-
mlprec/mld_z_onelev_mod.f90 | 13 +++-
mlprec/mld_z_prec_type.f90 | 63 ++++++++++++-------
65 files changed, 808 insertions(+), 324 deletions(-)
diff --git a/mlprec/impl/smoother/mld_c_as_smoother_clone.f90 b/mlprec/impl/smoother/mld_c_as_smoother_clone.f90
index 63882558..65daf8a4 100644
--- a/mlprec/impl/smoother/mld_c_as_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_c_as_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_c_as_smoother_type), intent(inout) :: sm
- class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_as_smoother_type), intent(inout) :: sm
+ class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,11 +54,17 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_c_as_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_c_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_c_as_smoother_type)
smo%novr = sm%novr
@@ -68,6 +74,10 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
class default
info = psb_err_internal_error_
diff --git a/mlprec/impl/smoother/mld_c_base_smoother_clone.f90 b/mlprec/impl/smoother/mld_c_base_smoother_clone.f90
index 8d478bfb..6a6b7715 100644
--- a/mlprec/impl/smoother/mld_c_base_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_c_base_smoother_clone.f90
@@ -42,8 +42,8 @@ subroutine mld_c_base_smoother_clone(sm,smout,info)
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_clone
Implicit None
! Arguments
- class(mld_c_base_smoother_type), intent(inout) :: sm
- class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_c_base_smoother_type), intent(inout) :: sm
+ class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'
diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
index 62a45077..c82aeaef 100644
--- a/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_c_jac_smoother_type), intent(inout) :: sm
- class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_jac_smoother_type), intent(inout) :: sm
+ class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_c_jac_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_c_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_c_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
-
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
+
class default
info = psb_err_internal_error_
end select
diff --git a/mlprec/impl/smoother/mld_d_as_smoother_clone.f90 b/mlprec/impl/smoother/mld_d_as_smoother_clone.f90
index f06564a7..f4f2fc42 100644
--- a/mlprec/impl/smoother/mld_d_as_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_d_as_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_d_as_smoother_type), intent(inout) :: sm
- class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_as_smoother_type), intent(inout) :: sm
+ class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,11 +54,17 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_d_as_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_d_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_d_as_smoother_type)
smo%novr = sm%novr
@@ -68,6 +74,10 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
class default
info = psb_err_internal_error_
diff --git a/mlprec/impl/smoother/mld_d_base_smoother_clone.f90 b/mlprec/impl/smoother/mld_d_base_smoother_clone.f90
index b8b76439..3c6c98cd 100644
--- a/mlprec/impl/smoother/mld_d_base_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_d_base_smoother_clone.f90
@@ -42,8 +42,8 @@ subroutine mld_d_base_smoother_clone(sm,smout,info)
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_clone
Implicit None
! Arguments
- class(mld_d_base_smoother_type), intent(inout) :: sm
- class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_d_base_smoother_type), intent(inout) :: sm
+ class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'
diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
index d87ccdd4..2288325d 100644
--- a/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_d_jac_smoother_type), intent(inout) :: sm
- class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_jac_smoother_type), intent(inout) :: sm
+ class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_d_jac_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_d_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_d_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
-
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
+
class default
info = psb_err_internal_error_
end select
diff --git a/mlprec/impl/smoother/mld_s_as_smoother_clone.f90 b/mlprec/impl/smoother/mld_s_as_smoother_clone.f90
index c26d4d07..3da6f2a5 100644
--- a/mlprec/impl/smoother/mld_s_as_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_s_as_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_s_as_smoother_type), intent(inout) :: sm
- class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_as_smoother_type), intent(inout) :: sm
+ class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,11 +54,17 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_s_as_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_s_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_s_as_smoother_type)
smo%novr = sm%novr
@@ -68,6 +74,10 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
class default
info = psb_err_internal_error_
diff --git a/mlprec/impl/smoother/mld_s_base_smoother_clone.f90 b/mlprec/impl/smoother/mld_s_base_smoother_clone.f90
index 3e5ba785..66e3a68c 100644
--- a/mlprec/impl/smoother/mld_s_base_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_s_base_smoother_clone.f90
@@ -42,8 +42,8 @@ subroutine mld_s_base_smoother_clone(sm,smout,info)
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_clone
Implicit None
! Arguments
- class(mld_s_base_smoother_type), intent(inout) :: sm
- class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_s_base_smoother_type), intent(inout) :: sm
+ class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'
diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
index 617d8cbc..a4e1a381 100644
--- a/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_s_jac_smoother_type), intent(inout) :: sm
- class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_jac_smoother_type), intent(inout) :: sm
+ class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_s_jac_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_s_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_s_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
-
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
+
class default
info = psb_err_internal_error_
end select
diff --git a/mlprec/impl/smoother/mld_z_as_smoother_clone.f90 b/mlprec/impl/smoother/mld_z_as_smoother_clone.f90
index a1a69e00..9885208d 100644
--- a/mlprec/impl/smoother/mld_z_as_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_z_as_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_z_as_smoother_type), intent(inout) :: sm
- class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_as_smoother_type), intent(inout) :: sm
+ class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,11 +54,17 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_z_as_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_z_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_z_as_smoother_type)
smo%novr = sm%novr
@@ -68,6 +74,10 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
class default
info = psb_err_internal_error_
diff --git a/mlprec/impl/smoother/mld_z_base_smoother_clone.f90 b/mlprec/impl/smoother/mld_z_base_smoother_clone.f90
index b669e14a..5d20b823 100644
--- a/mlprec/impl/smoother/mld_z_base_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_z_base_smoother_clone.f90
@@ -42,8 +42,8 @@ subroutine mld_z_base_smoother_clone(sm,smout,info)
use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_clone
Implicit None
! Arguments
- class(mld_z_base_smoother_type), intent(inout) :: sm
- class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_z_base_smoother_type), intent(inout) :: sm
+ class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'
diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
index 2ad3c2a0..7468582c 100644
--- a/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
+++ b/mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
@@ -44,9 +44,9 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
- class(mld_z_jac_smoother_type), intent(inout) :: sm
- class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_jac_smoother_type), intent(inout) :: sm
+ class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_z_jac_smoother_type :: smout, stat=info)
+ if (allocated(smout)) then
+ call smout%free(info)
+ if (info == psb_success_) deallocate(smout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_z_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(smo => smout)
type is (mld_z_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
-
+ if ((info==psb_success_).and.(allocated(sm%sv))) then
+ allocate(smout%sv,mold=sm%sv,stat=info)
+ if (info == psb_success_) call sm%sv%clone(smo%sv,info)
+ end if
+
class default
info = psb_err_internal_error_
end select
diff --git a/mlprec/impl/solver/mld_c_base_solver_clone.f90 b/mlprec/impl/solver/mld_c_base_solver_clone.f90
index e9a6d8f4..4e015a85 100644
--- a/mlprec/impl/solver/mld_c_base_solver_clone.f90
+++ b/mlprec/impl/solver/mld_c_base_solver_clone.f90
@@ -42,9 +42,9 @@ subroutine mld_c_base_solver_clone(sv,svout,info)
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_clone
Implicit None
! Arguments
- class(mld_c_base_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_base_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'
diff --git a/mlprec/impl/solver/mld_c_diag_solver_clone.f90 b/mlprec/impl/solver/mld_c_diag_solver_clone.f90
index 8161c8d6..3f7a6af2 100644
--- a/mlprec/impl/solver/mld_c_diag_solver_clone.f90
+++ b/mlprec/impl/solver/mld_c_diag_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_c_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_c_diag_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_diag_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_c_diag_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_c_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_c_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
diff --git a/mlprec/impl/solver/mld_c_id_solver_clone.f90 b/mlprec/impl/solver/mld_c_id_solver_clone.f90
index e6823b1e..d88b8c98 100644
--- a/mlprec/impl/solver/mld_c_id_solver_clone.f90
+++ b/mlprec/impl/solver/mld_c_id_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_c_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_c_id_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_id_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_c_id_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_c_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_c_id_solver_type)
! Nothing to be done.
diff --git a/mlprec/impl/solver/mld_c_ilu_solver_clone.f90 b/mlprec/impl/solver/mld_c_ilu_solver_clone.f90
index d64dcb13..14661fbb 100644
--- a/mlprec/impl/solver/mld_c_ilu_solver_clone.f90
+++ b/mlprec/impl/solver/mld_c_ilu_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_c_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_c_ilu_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_ilu_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
-
- allocate(mld_c_ilu_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_c_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(svo => svout)
type is (mld_c_ilu_solver_type)
svo%fact_type = sv%fact_type
diff --git a/mlprec/impl/solver/mld_d_base_solver_clone.f90 b/mlprec/impl/solver/mld_d_base_solver_clone.f90
index 213e96f0..d41f1766 100644
--- a/mlprec/impl/solver/mld_d_base_solver_clone.f90
+++ b/mlprec/impl/solver/mld_d_base_solver_clone.f90
@@ -42,9 +42,9 @@ subroutine mld_d_base_solver_clone(sv,svout,info)
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_clone
Implicit None
! Arguments
- class(mld_d_base_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_base_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'
diff --git a/mlprec/impl/solver/mld_d_diag_solver_clone.f90 b/mlprec/impl/solver/mld_d_diag_solver_clone.f90
index c026fbb9..c75e04a8 100644
--- a/mlprec/impl/solver/mld_d_diag_solver_clone.f90
+++ b/mlprec/impl/solver/mld_d_diag_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_d_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_d_diag_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_diag_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_d_diag_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_d_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_d_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
diff --git a/mlprec/impl/solver/mld_d_id_solver_clone.f90 b/mlprec/impl/solver/mld_d_id_solver_clone.f90
index 5f4ae281..6e55027f 100644
--- a/mlprec/impl/solver/mld_d_id_solver_clone.f90
+++ b/mlprec/impl/solver/mld_d_id_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_d_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_d_id_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_id_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_d_id_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_d_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_d_id_solver_type)
! Nothing to be done.
diff --git a/mlprec/impl/solver/mld_d_ilu_solver_clone.f90 b/mlprec/impl/solver/mld_d_ilu_solver_clone.f90
index c1323a0f..b37a9fd1 100644
--- a/mlprec/impl/solver/mld_d_ilu_solver_clone.f90
+++ b/mlprec/impl/solver/mld_d_ilu_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_d_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_d_ilu_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_ilu_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
-
- allocate(mld_d_ilu_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_d_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(svo => svout)
type is (mld_d_ilu_solver_type)
svo%fact_type = sv%fact_type
diff --git a/mlprec/impl/solver/mld_s_base_solver_clone.f90 b/mlprec/impl/solver/mld_s_base_solver_clone.f90
index cc5c2445..863b7257 100644
--- a/mlprec/impl/solver/mld_s_base_solver_clone.f90
+++ b/mlprec/impl/solver/mld_s_base_solver_clone.f90
@@ -42,9 +42,9 @@ subroutine mld_s_base_solver_clone(sv,svout,info)
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_clone
Implicit None
! Arguments
- class(mld_s_base_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_base_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'
diff --git a/mlprec/impl/solver/mld_s_diag_solver_clone.f90 b/mlprec/impl/solver/mld_s_diag_solver_clone.f90
index 7c181826..4d653324 100644
--- a/mlprec/impl/solver/mld_s_diag_solver_clone.f90
+++ b/mlprec/impl/solver/mld_s_diag_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_s_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_s_diag_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_diag_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_s_diag_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_s_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_s_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
diff --git a/mlprec/impl/solver/mld_s_id_solver_clone.f90 b/mlprec/impl/solver/mld_s_id_solver_clone.f90
index 9776d791..5eb6c73b 100644
--- a/mlprec/impl/solver/mld_s_id_solver_clone.f90
+++ b/mlprec/impl/solver/mld_s_id_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_s_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_s_id_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_id_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_s_id_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_s_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_s_id_solver_type)
! Nothing to be done.
diff --git a/mlprec/impl/solver/mld_s_ilu_solver_clone.f90 b/mlprec/impl/solver/mld_s_ilu_solver_clone.f90
index d2fad046..19f32433 100644
--- a/mlprec/impl/solver/mld_s_ilu_solver_clone.f90
+++ b/mlprec/impl/solver/mld_s_ilu_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_s_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_s_ilu_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_ilu_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
-
- allocate(mld_s_ilu_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_s_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(svo => svout)
type is (mld_s_ilu_solver_type)
svo%fact_type = sv%fact_type
diff --git a/mlprec/impl/solver/mld_z_base_solver_clone.f90 b/mlprec/impl/solver/mld_z_base_solver_clone.f90
index ca0050b6..6ac0047d 100644
--- a/mlprec/impl/solver/mld_z_base_solver_clone.f90
+++ b/mlprec/impl/solver/mld_z_base_solver_clone.f90
@@ -42,9 +42,9 @@ subroutine mld_z_base_solver_clone(sv,svout,info)
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_clone
Implicit None
! Arguments
- class(mld_z_base_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_base_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'
diff --git a/mlprec/impl/solver/mld_z_diag_solver_clone.f90 b/mlprec/impl/solver/mld_z_diag_solver_clone.f90
index d1e1266b..d4c75e93 100644
--- a/mlprec/impl/solver/mld_z_diag_solver_clone.f90
+++ b/mlprec/impl/solver/mld_z_diag_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_z_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_z_diag_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_diag_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_z_diag_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_z_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_z_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
diff --git a/mlprec/impl/solver/mld_z_id_solver_clone.f90 b/mlprec/impl/solver/mld_z_id_solver_clone.f90
index 6612196a..d6f0b27b 100644
--- a/mlprec/impl/solver/mld_z_id_solver_clone.f90
+++ b/mlprec/impl/solver/mld_z_id_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_z_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_z_id_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_id_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
- allocate(mld_z_id_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_z_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
-
+
select type(svo => svout)
type is (mld_z_id_solver_type)
! Nothing to be done.
diff --git a/mlprec/impl/solver/mld_z_ilu_solver_clone.f90 b/mlprec/impl/solver/mld_z_ilu_solver_clone.f90
index 0fb44681..e8681446 100644
--- a/mlprec/impl/solver/mld_z_ilu_solver_clone.f90
+++ b/mlprec/impl/solver/mld_z_ilu_solver_clone.f90
@@ -44,21 +44,26 @@ subroutine mld_z_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
- class(mld_z_ilu_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_ilu_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
info=psb_success_
call psb_erractionsave(err_act)
-
- allocate(mld_z_ilu_solver_type :: svout, stat=info)
+ if (allocated(svout)) then
+ call svout%free(info)
+ if (info == psb_success_) deallocate(svout, stat=info)
+ end if
+ if (info == psb_success_) &
+ & allocate(mld_z_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
+
select type(svo => svout)
type is (mld_z_ilu_solver_type)
svo%fact_type = sv%fact_type
diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90
index 5bc99dc9..2a02043f 100644
--- a/mlprec/mld_base_prec_type.F90
+++ b/mlprec/mld_base_prec_type.F90
@@ -79,10 +79,10 @@ module mld_base_prec_type
!
! Version numbers
!
- character(len=*), parameter :: mld_version_string_ = "2.0.0"
- integer(psb_ipk_), parameter :: mld_version_major_ = 2
- integer(psb_ipk_), parameter :: mld_version_minor_ = 0
- integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
+ character(len=*), parameter :: mld_version_string_ = "2.0.0"
+ integer(psb_ipk_), parameter :: mld_version_major_ = 2
+ integer(psb_ipk_), parameter :: mld_version_minor_ = 0
+ integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
type mld_aux_onelev_map_type
diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90
index 991887eb..d3af5c68 100644
--- a/mlprec/mld_c_as_smoother.f90
+++ b/mlprec/mld_c_as_smoother.f90
@@ -70,11 +70,13 @@ module mld_c_as_smoother
procedure, pass(sm) :: sizeof => c_as_smoother_sizeof
procedure, pass(sm) :: default => c_as_smoother_default
procedure, pass(sm) :: get_nzeros => c_as_smoother_get_nzeros
+ procedure, nopass :: get_fmt => c_as_smoother_get_fmt
end type mld_c_as_smoother_type
private :: c_as_smoother_descr, c_as_smoother_sizeof, &
- & c_as_smoother_default, c_as_smoother_get_nzeros
+ & c_as_smoother_default, c_as_smoother_get_nzeros, &
+ & c_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_c_as_smoother
subroutine mld_c_as_smoother_clone(sm,smout,info)
import :: mld_c_as_smoother_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
- class(mld_c_as_smoother_type), intent(inout) :: sm
- class(mld_c_base_smoother_type), intent(out) :: smout
+ class(mld_c_as_smoother_type), intent(inout) :: sm
+ class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_clone
end interface
@@ -352,4 +354,11 @@ contains
return
end subroutine c_as_smoother_descr
+ function c_as_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Schwarz smoother"
+ end function c_as_smoother_get_fmt
+
end module mld_c_as_smoother
diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90
index 0fb3e09e..c1ac1d12 100644
--- a/mlprec/mld_c_base_smoother_mod.f90
+++ b/mlprec/mld_c_base_smoother_mod.f90
@@ -112,10 +112,11 @@ module mld_c_base_smoother_mod
procedure, pass(sm) :: sizeof => c_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => c_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => c_base_smoother_get_fmt
end type mld_c_base_smoother_type
- private :: c_base_smoother_sizeof, &
+ private :: c_base_smoother_sizeof, c_base_smoother_get_fmt, &
& c_base_smoother_default, c_base_smoother_get_nzeros
@@ -304,8 +305,8 @@ module mld_c_base_smoother_mod
Implicit None
! Arguments
- class(mld_c_base_smoother_type), intent(inout) :: sm
- class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_c_base_smoother_type), intent(inout) :: sm
+ class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_clone
end interface
@@ -357,5 +358,11 @@ contains
return
end subroutine c_base_smoother_default
+ function c_base_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base smoother"
+ end function c_base_smoother_get_fmt
end module mld_c_base_smoother_mod
diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90
index d647b5ed..0a4b7eac 100644
--- a/mlprec/mld_c_base_solver_mod.f90
+++ b/mlprec/mld_c_base_solver_mod.f90
@@ -104,10 +104,11 @@ module mld_c_base_solver_mod
procedure, pass(sv) :: sizeof => c_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => c_base_solver_get_fmt
end type mld_c_base_solver_type
private :: c_base_solver_sizeof, c_base_solver_default,&
- & c_base_solver_get_nzeros
+ & c_base_solver_get_nzeros, c_base_solver_get_fmt
interface
@@ -318,9 +319,9 @@ module mld_c_base_solver_mod
Implicit None
! Arguments
- class(mld_c_base_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_base_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_clone
end interface
@@ -360,4 +361,12 @@ contains
return
end subroutine c_base_solver_default
+ function c_base_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base solver"
+ end function c_base_solver_get_fmt
+
+
end module mld_c_base_solver_mod
diff --git a/mlprec/mld_c_diag_solver.f90 b/mlprec/mld_c_diag_solver.f90
index 943da415..1b5642a7 100644
--- a/mlprec/mld_c_diag_solver.f90
+++ b/mlprec/mld_c_diag_solver.f90
@@ -59,11 +59,13 @@ module mld_c_diag_solver
procedure, pass(sv) :: descr => c_diag_solver_descr
procedure, pass(sv) :: sizeof => c_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_diag_solver_get_nzeros
+ procedure, nopass :: get_fmt => c_diag_solver_get_fmt
end type mld_c_diag_solver_type
private :: c_diag_solver_free, c_diag_solver_descr, &
- & c_diag_solver_sizeof, c_diag_solver_get_nzeros
+ & c_diag_solver_sizeof, c_diag_solver_get_nzeros, &
+ & c_diag_solver_get_fmt
interface
@@ -122,9 +124,9 @@ module mld_c_diag_solver
Implicit None
! Arguments
- class(mld_c_diag_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_diag_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_diag_solver_clone
end interface
@@ -221,4 +223,12 @@ contains
return
end function c_diag_solver_get_nzeros
+ function c_diag_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Diag solver"
+ end function c_diag_solver_get_fmt
+
+
end module mld_c_diag_solver
diff --git a/mlprec/mld_c_id_solver.f90 b/mlprec/mld_c_id_solver.f90
index 64ee0d76..bed3af3c 100644
--- a/mlprec/mld_c_id_solver.f90
+++ b/mlprec/mld_c_id_solver.f90
@@ -55,11 +55,12 @@ module mld_c_id_solver
procedure, pass(sv) :: apply_a => mld_c_id_solver_apply
procedure, pass(sv) :: free => c_id_solver_free
procedure, pass(sv) :: descr => c_id_solver_descr
+ procedure, nopass :: get_fmt => c_id_solver_get_fmt
end type mld_c_id_solver_type
private :: c_id_solver_bld, &
- & c_id_solver_free, &
+ & c_id_solver_free, c_id_solver_get_fmt, &
& c_id_solver_descr
interface
@@ -102,9 +103,9 @@ module mld_c_id_solver
Implicit None
! Arguments
- class(mld_c_id_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_id_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_id_solver_clone
end interface
@@ -178,4 +179,12 @@ contains
end subroutine c_id_solver_descr
+ function c_id_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Identity solver"
+ end function c_id_solver_get_fmt
+
+
end module mld_c_id_solver
diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90
index 796fd5b2..9b0c2908 100644
--- a/mlprec/mld_c_ilu_solver.f90
+++ b/mlprec/mld_c_ilu_solver.f90
@@ -71,6 +71,7 @@ module mld_c_ilu_solver
procedure, pass(sv) :: default => c_ilu_solver_default
procedure, pass(sv) :: sizeof => c_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_ilu_solver_get_nzeros
+ procedure, nopass :: get_fmt => c_ilu_solver_get_fmt
end type mld_c_ilu_solver_type
@@ -79,7 +80,8 @@ module mld_c_ilu_solver
& c_ilu_solver_setc, c_ilu_solver_setr,&
& c_ilu_solver_descr, c_ilu_solver_sizeof, &
& c_ilu_solver_default, c_ilu_solver_dmp, &
- & c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros
+ & c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros, &
+ & c_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@@ -162,9 +164,9 @@ module mld_c_ilu_solver
Implicit None
! Arguments
- class(mld_c_ilu_solver_type), intent(inout) :: sv
- class(mld_c_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_c_ilu_solver_type), intent(inout) :: sv
+ class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_ilu_solver_clone
end interface
@@ -556,4 +558,11 @@ contains
return
end function c_ilu_solver_sizeof
+ function c_ilu_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "ILU solver"
+ end function c_ilu_solver_get_fmt
+
end module mld_c_ilu_solver
diff --git a/mlprec/mld_c_jac_smoother.f90 b/mlprec/mld_c_jac_smoother.f90
index 410f3656..67e572b5 100644
--- a/mlprec/mld_c_jac_smoother.f90
+++ b/mlprec/mld_c_jac_smoother.f90
@@ -62,11 +62,13 @@ module mld_c_jac_smoother
procedure, pass(sm) :: descr => c_jac_smoother_descr
procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => c_jac_smoother_get_nzeros
+ procedure, nopass :: get_fmt => c_jac_smoother_get_fmt
end type mld_c_jac_smoother_type
private :: c_jac_smoother_free, c_jac_smoother_descr, &
- & c_jac_smoother_sizeof, c_jac_smoother_get_nzeros
+ & c_jac_smoother_sizeof, c_jac_smoother_get_nzeros, &
+ & c_jac_smoother_get_fmt
interface
@@ -120,8 +122,8 @@ module mld_c_jac_smoother
subroutine mld_c_jac_smoother_clone(sm,smout,info)
import :: mld_c_jac_smoother_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
- class(mld_c_jac_smoother_type), intent(inout) :: sm
- class(mld_c_base_smoother_type), intent(out) :: smout
+ class(mld_c_jac_smoother_type), intent(inout) :: sm
+ class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_jac_smoother_clone
end interface
@@ -247,4 +249,11 @@ contains
return
end function c_jac_smoother_get_nzeros
+ function c_jac_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Jacobi smoother"
+ end function c_jac_smoother_get_fmt
+
end module mld_c_jac_smoother
diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90
index 1051d85f..74b498b0 100644
--- a/mlprec/mld_c_onelev_mod.f90
+++ b/mlprec/mld_c_onelev_mod.f90
@@ -385,11 +385,18 @@ contains
! Arguments
class(mld_c_onelev_type), target, intent(inout) :: lv
- class(mld_c_onelev_type), intent(out) :: lvout
+ class(mld_c_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
- if (allocated(lv%sm)) &
- & call lv%sm%clone(lvout%sm,info)
+ info = psb_success_
+ if (allocated(lv%sm)) then
+ call lv%sm%clone(lvout%sm,info)
+ else
+ if (allocated(lvout%sm)) then
+ call lvout%sm%free(info)
+ if (info==psb_success_) deallocate(lvout%sm,stat=info)
+ end if
+ end if
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90
index 90cff70d..57ba740e 100644
--- a/mlprec/mld_c_prec_type.f90
+++ b/mlprec/mld_c_prec_type.f90
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_cprec_type), intent(inout) :: prec
- class(mld_cprec_type), target, intent(out) :: precout
- integer(psb_ipk_), intent(out) :: info
+ class(psb_cprec_type), intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
+
+ call mld_c_inner_clone(prec,precout,info)
+
+ end subroutine mld_c_clone
+
+ subroutine mld_c_inner_clone(prec,precout,info)
+
+ implicit none
+ class(mld_cprec_type), intent(inout) :: prec
+ class(psb_cprec_type), target, intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
- precout%ictxt = prec%ictxt
- precout%coarse_aggr_size = prec%coarse_aggr_size
- precout%op_complexity = prec%op_complexity
- if (allocated(prec%precv)) then
- ln = size(prec%precv)
- allocate(precout%precv(ln),stat=info)
- if (info /= psb_success_) goto 9999
- if (ln > 1) then
- call prec%precv(1)%clone(precout%precv(1),info)
- end if
- do lev=2, ln
- if (info /= psb_success_) exit
- call prec%precv(lev)%clone(precout%precv(lev),info)
- if (info == psb_success_) then
- precout%precv(lev)%base_a => precout%precv(lev)%ac
- precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
- precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
- precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+ select type(pout => precout)
+ class is (mld_cprec_type)
+ pout%ictxt = prec%ictxt
+ pout%coarse_aggr_size = prec%coarse_aggr_size
+ pout%op_complexity = prec%op_complexity
+ if (allocated(prec%precv)) then
+ ln = size(prec%precv)
+ allocate(pout%precv(ln),stat=info)
+ if (info /= psb_success_) goto 9999
+ if (ln >= 1) then
+ call prec%precv(1)%clone(pout%precv(1),info)
end if
- end do
- end if
+ do lev=2, ln
+ if (info /= psb_success_) exit
+ call prec%precv(lev)%clone(pout%precv(lev),info)
+ if (info == psb_success_) then
+ pout%precv(lev)%base_a => pout%precv(lev)%ac
+ pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
+ pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
+ pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
+ end if
+ end do
+ end if
+ class default
+ write(0,*) 'Error: wrong out type'
+ info = psb_err_invalid_input_
+ end select
9999 continue
- end subroutine mld_c_clone
+ end subroutine mld_c_inner_clone
subroutine mld_cprec_move_alloc(a, b,info)
use psb_base_mod
diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90
index bf0b5d00..f46c2d5a 100644
--- a/mlprec/mld_d_as_smoother.f90
+++ b/mlprec/mld_d_as_smoother.f90
@@ -70,11 +70,13 @@ module mld_d_as_smoother
procedure, pass(sm) :: sizeof => d_as_smoother_sizeof
procedure, pass(sm) :: default => d_as_smoother_default
procedure, pass(sm) :: get_nzeros => d_as_smoother_get_nzeros
+ procedure, nopass :: get_fmt => d_as_smoother_get_fmt
end type mld_d_as_smoother_type
private :: d_as_smoother_descr, d_as_smoother_sizeof, &
- & d_as_smoother_default, d_as_smoother_get_nzeros
+ & d_as_smoother_default, d_as_smoother_get_nzeros, &
+ & d_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_d_as_smoother
subroutine mld_d_as_smoother_clone(sm,smout,info)
import :: mld_d_as_smoother_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
- class(mld_d_as_smoother_type), intent(inout) :: sm
- class(mld_d_base_smoother_type), intent(out) :: smout
+ class(mld_d_as_smoother_type), intent(inout) :: sm
+ class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_clone
end interface
@@ -352,4 +354,11 @@ contains
return
end subroutine d_as_smoother_descr
+ function d_as_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Schwarz smoother"
+ end function d_as_smoother_get_fmt
+
end module mld_d_as_smoother
diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90
index 6f7cc194..7da85ede 100644
--- a/mlprec/mld_d_base_smoother_mod.f90
+++ b/mlprec/mld_d_base_smoother_mod.f90
@@ -112,10 +112,11 @@ module mld_d_base_smoother_mod
procedure, pass(sm) :: sizeof => d_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => d_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => d_base_smoother_get_fmt
end type mld_d_base_smoother_type
- private :: d_base_smoother_sizeof, &
+ private :: d_base_smoother_sizeof, d_base_smoother_get_fmt, &
& d_base_smoother_default, d_base_smoother_get_nzeros
@@ -304,8 +305,8 @@ module mld_d_base_smoother_mod
Implicit None
! Arguments
- class(mld_d_base_smoother_type), intent(inout) :: sm
- class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_d_base_smoother_type), intent(inout) :: sm
+ class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_clone
end interface
@@ -357,5 +358,11 @@ contains
return
end subroutine d_base_smoother_default
+ function d_base_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base smoother"
+ end function d_base_smoother_get_fmt
end module mld_d_base_smoother_mod
diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90
index ec2c5fc1..65aafbe3 100644
--- a/mlprec/mld_d_base_solver_mod.f90
+++ b/mlprec/mld_d_base_solver_mod.f90
@@ -104,10 +104,11 @@ module mld_d_base_solver_mod
procedure, pass(sv) :: sizeof => d_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => d_base_solver_get_fmt
end type mld_d_base_solver_type
private :: d_base_solver_sizeof, d_base_solver_default,&
- & d_base_solver_get_nzeros
+ & d_base_solver_get_nzeros, d_base_solver_get_fmt
interface
@@ -318,9 +319,9 @@ module mld_d_base_solver_mod
Implicit None
! Arguments
- class(mld_d_base_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_base_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_clone
end interface
@@ -360,4 +361,12 @@ contains
return
end subroutine d_base_solver_default
+ function d_base_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base solver"
+ end function d_base_solver_get_fmt
+
+
end module mld_d_base_solver_mod
diff --git a/mlprec/mld_d_diag_solver.f90 b/mlprec/mld_d_diag_solver.f90
index 4eb1d7b5..fea35161 100644
--- a/mlprec/mld_d_diag_solver.f90
+++ b/mlprec/mld_d_diag_solver.f90
@@ -59,11 +59,13 @@ module mld_d_diag_solver
procedure, pass(sv) :: descr => d_diag_solver_descr
procedure, pass(sv) :: sizeof => d_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_diag_solver_get_nzeros
+ procedure, nopass :: get_fmt => d_diag_solver_get_fmt
end type mld_d_diag_solver_type
private :: d_diag_solver_free, d_diag_solver_descr, &
- & d_diag_solver_sizeof, d_diag_solver_get_nzeros
+ & d_diag_solver_sizeof, d_diag_solver_get_nzeros, &
+ & d_diag_solver_get_fmt
interface
@@ -122,9 +124,9 @@ module mld_d_diag_solver
Implicit None
! Arguments
- class(mld_d_diag_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_diag_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_diag_solver_clone
end interface
@@ -221,4 +223,12 @@ contains
return
end function d_diag_solver_get_nzeros
+ function d_diag_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Diag solver"
+ end function d_diag_solver_get_fmt
+
+
end module mld_d_diag_solver
diff --git a/mlprec/mld_d_id_solver.f90 b/mlprec/mld_d_id_solver.f90
index 3140042b..0fc069c5 100644
--- a/mlprec/mld_d_id_solver.f90
+++ b/mlprec/mld_d_id_solver.f90
@@ -55,11 +55,12 @@ module mld_d_id_solver
procedure, pass(sv) :: apply_a => mld_d_id_solver_apply
procedure, pass(sv) :: free => d_id_solver_free
procedure, pass(sv) :: descr => d_id_solver_descr
+ procedure, nopass :: get_fmt => d_id_solver_get_fmt
end type mld_d_id_solver_type
private :: d_id_solver_bld, &
- & d_id_solver_free, &
+ & d_id_solver_free, d_id_solver_get_fmt, &
& d_id_solver_descr
interface
@@ -102,9 +103,9 @@ module mld_d_id_solver
Implicit None
! Arguments
- class(mld_d_id_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_id_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_id_solver_clone
end interface
@@ -178,4 +179,12 @@ contains
end subroutine d_id_solver_descr
+ function d_id_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Identity solver"
+ end function d_id_solver_get_fmt
+
+
end module mld_d_id_solver
diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90
index f9b391d9..adf8ed11 100644
--- a/mlprec/mld_d_ilu_solver.f90
+++ b/mlprec/mld_d_ilu_solver.f90
@@ -71,6 +71,7 @@ module mld_d_ilu_solver
procedure, pass(sv) :: default => d_ilu_solver_default
procedure, pass(sv) :: sizeof => d_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_ilu_solver_get_nzeros
+ procedure, nopass :: get_fmt => d_ilu_solver_get_fmt
end type mld_d_ilu_solver_type
@@ -79,7 +80,8 @@ module mld_d_ilu_solver
& d_ilu_solver_setc, d_ilu_solver_setr,&
& d_ilu_solver_descr, d_ilu_solver_sizeof, &
& d_ilu_solver_default, d_ilu_solver_dmp, &
- & d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros
+ & d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros, &
+ & d_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@@ -162,9 +164,9 @@ module mld_d_ilu_solver
Implicit None
! Arguments
- class(mld_d_ilu_solver_type), intent(inout) :: sv
- class(mld_d_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_d_ilu_solver_type), intent(inout) :: sv
+ class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_ilu_solver_clone
end interface
@@ -556,4 +558,11 @@ contains
return
end function d_ilu_solver_sizeof
+ function d_ilu_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "ILU solver"
+ end function d_ilu_solver_get_fmt
+
end module mld_d_ilu_solver
diff --git a/mlprec/mld_d_jac_smoother.f90 b/mlprec/mld_d_jac_smoother.f90
index 357e89c6..3192d71f 100644
--- a/mlprec/mld_d_jac_smoother.f90
+++ b/mlprec/mld_d_jac_smoother.f90
@@ -62,11 +62,13 @@ module mld_d_jac_smoother
procedure, pass(sm) :: descr => d_jac_smoother_descr
procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => d_jac_smoother_get_nzeros
+ procedure, nopass :: get_fmt => d_jac_smoother_get_fmt
end type mld_d_jac_smoother_type
private :: d_jac_smoother_free, d_jac_smoother_descr, &
- & d_jac_smoother_sizeof, d_jac_smoother_get_nzeros
+ & d_jac_smoother_sizeof, d_jac_smoother_get_nzeros, &
+ & d_jac_smoother_get_fmt
interface
@@ -120,8 +122,8 @@ module mld_d_jac_smoother
subroutine mld_d_jac_smoother_clone(sm,smout,info)
import :: mld_d_jac_smoother_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
- class(mld_d_jac_smoother_type), intent(inout) :: sm
- class(mld_d_base_smoother_type), intent(out) :: smout
+ class(mld_d_jac_smoother_type), intent(inout) :: sm
+ class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_jac_smoother_clone
end interface
@@ -247,4 +249,11 @@ contains
return
end function d_jac_smoother_get_nzeros
+ function d_jac_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Jacobi smoother"
+ end function d_jac_smoother_get_fmt
+
end module mld_d_jac_smoother
diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90
index 88e101bf..0d60249d 100644
--- a/mlprec/mld_d_onelev_mod.f90
+++ b/mlprec/mld_d_onelev_mod.f90
@@ -385,11 +385,18 @@ contains
! Arguments
class(mld_d_onelev_type), target, intent(inout) :: lv
- class(mld_d_onelev_type), intent(out) :: lvout
+ class(mld_d_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
- if (allocated(lv%sm)) &
- & call lv%sm%clone(lvout%sm,info)
+ info = psb_success_
+ if (allocated(lv%sm)) then
+ call lv%sm%clone(lvout%sm,info)
+ else
+ if (allocated(lvout%sm)) then
+ call lvout%sm%free(info)
+ if (info==psb_success_) deallocate(lvout%sm,stat=info)
+ end if
+ end if
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90
index e5d670c7..eb55979e 100644
--- a/mlprec/mld_d_prec_type.f90
+++ b/mlprec/mld_d_prec_type.f90
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_dprec_type), intent(inout) :: prec
- class(mld_dprec_type), target, intent(out) :: precout
- integer(psb_ipk_), intent(out) :: info
+ class(psb_dprec_type), intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
+
+ call mld_d_inner_clone(prec,precout,info)
+
+ end subroutine mld_d_clone
+
+ subroutine mld_d_inner_clone(prec,precout,info)
+
+ implicit none
+ class(mld_dprec_type), intent(inout) :: prec
+ class(psb_dprec_type), target, intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
- precout%ictxt = prec%ictxt
- precout%coarse_aggr_size = prec%coarse_aggr_size
- precout%op_complexity = prec%op_complexity
- if (allocated(prec%precv)) then
- ln = size(prec%precv)
- allocate(precout%precv(ln),stat=info)
- if (info /= psb_success_) goto 9999
- if (ln > 1) then
- call prec%precv(1)%clone(precout%precv(1),info)
- end if
- do lev=2, ln
- if (info /= psb_success_) exit
- call prec%precv(lev)%clone(precout%precv(lev),info)
- if (info == psb_success_) then
- precout%precv(lev)%base_a => precout%precv(lev)%ac
- precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
- precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
- precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+ select type(pout => precout)
+ class is (mld_dprec_type)
+ pout%ictxt = prec%ictxt
+ pout%coarse_aggr_size = prec%coarse_aggr_size
+ pout%op_complexity = prec%op_complexity
+ if (allocated(prec%precv)) then
+ ln = size(prec%precv)
+ allocate(pout%precv(ln),stat=info)
+ if (info /= psb_success_) goto 9999
+ if (ln >= 1) then
+ call prec%precv(1)%clone(pout%precv(1),info)
end if
- end do
- end if
+ do lev=2, ln
+ if (info /= psb_success_) exit
+ call prec%precv(lev)%clone(pout%precv(lev),info)
+ if (info == psb_success_) then
+ pout%precv(lev)%base_a => pout%precv(lev)%ac
+ pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
+ pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
+ pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
+ end if
+ end do
+ end if
+ class default
+ write(0,*) 'Error: wrong out type'
+ info = psb_err_invalid_input_
+ end select
9999 continue
- end subroutine mld_d_clone
+ end subroutine mld_d_inner_clone
subroutine mld_dprec_move_alloc(a, b,info)
use psb_base_mod
diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90
index 4d2d84ed..436f0f90 100644
--- a/mlprec/mld_s_as_smoother.f90
+++ b/mlprec/mld_s_as_smoother.f90
@@ -70,11 +70,13 @@ module mld_s_as_smoother
procedure, pass(sm) :: sizeof => s_as_smoother_sizeof
procedure, pass(sm) :: default => s_as_smoother_default
procedure, pass(sm) :: get_nzeros => s_as_smoother_get_nzeros
+ procedure, nopass :: get_fmt => s_as_smoother_get_fmt
end type mld_s_as_smoother_type
private :: s_as_smoother_descr, s_as_smoother_sizeof, &
- & s_as_smoother_default, s_as_smoother_get_nzeros
+ & s_as_smoother_default, s_as_smoother_get_nzeros, &
+ & s_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_s_as_smoother
subroutine mld_s_as_smoother_clone(sm,smout,info)
import :: mld_s_as_smoother_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
- class(mld_s_as_smoother_type), intent(inout) :: sm
- class(mld_s_base_smoother_type), intent(out) :: smout
+ class(mld_s_as_smoother_type), intent(inout) :: sm
+ class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_clone
end interface
@@ -352,4 +354,11 @@ contains
return
end subroutine s_as_smoother_descr
+ function s_as_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Schwarz smoother"
+ end function s_as_smoother_get_fmt
+
end module mld_s_as_smoother
diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90
index 55525617..66fc16df 100644
--- a/mlprec/mld_s_base_smoother_mod.f90
+++ b/mlprec/mld_s_base_smoother_mod.f90
@@ -112,10 +112,11 @@ module mld_s_base_smoother_mod
procedure, pass(sm) :: sizeof => s_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => s_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => s_base_smoother_get_fmt
end type mld_s_base_smoother_type
- private :: s_base_smoother_sizeof, &
+ private :: s_base_smoother_sizeof, s_base_smoother_get_fmt, &
& s_base_smoother_default, s_base_smoother_get_nzeros
@@ -304,8 +305,8 @@ module mld_s_base_smoother_mod
Implicit None
! Arguments
- class(mld_s_base_smoother_type), intent(inout) :: sm
- class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_s_base_smoother_type), intent(inout) :: sm
+ class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_clone
end interface
@@ -357,5 +358,11 @@ contains
return
end subroutine s_base_smoother_default
+ function s_base_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base smoother"
+ end function s_base_smoother_get_fmt
end module mld_s_base_smoother_mod
diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90
index f9f871f4..d58089d8 100644
--- a/mlprec/mld_s_base_solver_mod.f90
+++ b/mlprec/mld_s_base_solver_mod.f90
@@ -104,10 +104,11 @@ module mld_s_base_solver_mod
procedure, pass(sv) :: sizeof => s_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => s_base_solver_get_fmt
end type mld_s_base_solver_type
private :: s_base_solver_sizeof, s_base_solver_default,&
- & s_base_solver_get_nzeros
+ & s_base_solver_get_nzeros, s_base_solver_get_fmt
interface
@@ -318,9 +319,9 @@ module mld_s_base_solver_mod
Implicit None
! Arguments
- class(mld_s_base_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_base_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_clone
end interface
@@ -360,4 +361,12 @@ contains
return
end subroutine s_base_solver_default
+ function s_base_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base solver"
+ end function s_base_solver_get_fmt
+
+
end module mld_s_base_solver_mod
diff --git a/mlprec/mld_s_diag_solver.f90 b/mlprec/mld_s_diag_solver.f90
index 10bea87d..16372ae4 100644
--- a/mlprec/mld_s_diag_solver.f90
+++ b/mlprec/mld_s_diag_solver.f90
@@ -59,11 +59,13 @@ module mld_s_diag_solver
procedure, pass(sv) :: descr => s_diag_solver_descr
procedure, pass(sv) :: sizeof => s_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_diag_solver_get_nzeros
+ procedure, nopass :: get_fmt => s_diag_solver_get_fmt
end type mld_s_diag_solver_type
private :: s_diag_solver_free, s_diag_solver_descr, &
- & s_diag_solver_sizeof, s_diag_solver_get_nzeros
+ & s_diag_solver_sizeof, s_diag_solver_get_nzeros, &
+ & s_diag_solver_get_fmt
interface
@@ -122,9 +124,9 @@ module mld_s_diag_solver
Implicit None
! Arguments
- class(mld_s_diag_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_diag_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_diag_solver_clone
end interface
@@ -221,4 +223,12 @@ contains
return
end function s_diag_solver_get_nzeros
+ function s_diag_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Diag solver"
+ end function s_diag_solver_get_fmt
+
+
end module mld_s_diag_solver
diff --git a/mlprec/mld_s_id_solver.f90 b/mlprec/mld_s_id_solver.f90
index 8c0b2097..e69ecc25 100644
--- a/mlprec/mld_s_id_solver.f90
+++ b/mlprec/mld_s_id_solver.f90
@@ -55,11 +55,12 @@ module mld_s_id_solver
procedure, pass(sv) :: apply_a => mld_s_id_solver_apply
procedure, pass(sv) :: free => s_id_solver_free
procedure, pass(sv) :: descr => s_id_solver_descr
+ procedure, nopass :: get_fmt => s_id_solver_get_fmt
end type mld_s_id_solver_type
private :: s_id_solver_bld, &
- & s_id_solver_free, &
+ & s_id_solver_free, s_id_solver_get_fmt, &
& s_id_solver_descr
interface
@@ -102,9 +103,9 @@ module mld_s_id_solver
Implicit None
! Arguments
- class(mld_s_id_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_id_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_id_solver_clone
end interface
@@ -178,4 +179,12 @@ contains
end subroutine s_id_solver_descr
+ function s_id_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Identity solver"
+ end function s_id_solver_get_fmt
+
+
end module mld_s_id_solver
diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90
index 46cc8572..5233f2b0 100644
--- a/mlprec/mld_s_ilu_solver.f90
+++ b/mlprec/mld_s_ilu_solver.f90
@@ -71,6 +71,7 @@ module mld_s_ilu_solver
procedure, pass(sv) :: default => s_ilu_solver_default
procedure, pass(sv) :: sizeof => s_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_ilu_solver_get_nzeros
+ procedure, nopass :: get_fmt => s_ilu_solver_get_fmt
end type mld_s_ilu_solver_type
@@ -79,7 +80,8 @@ module mld_s_ilu_solver
& s_ilu_solver_setc, s_ilu_solver_setr,&
& s_ilu_solver_descr, s_ilu_solver_sizeof, &
& s_ilu_solver_default, s_ilu_solver_dmp, &
- & s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros
+ & s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros, &
+ & s_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@@ -162,9 +164,9 @@ module mld_s_ilu_solver
Implicit None
! Arguments
- class(mld_s_ilu_solver_type), intent(inout) :: sv
- class(mld_s_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_s_ilu_solver_type), intent(inout) :: sv
+ class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_ilu_solver_clone
end interface
@@ -556,4 +558,11 @@ contains
return
end function s_ilu_solver_sizeof
+ function s_ilu_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "ILU solver"
+ end function s_ilu_solver_get_fmt
+
end module mld_s_ilu_solver
diff --git a/mlprec/mld_s_jac_smoother.f90 b/mlprec/mld_s_jac_smoother.f90
index 5a95d422..1fa7f094 100644
--- a/mlprec/mld_s_jac_smoother.f90
+++ b/mlprec/mld_s_jac_smoother.f90
@@ -62,11 +62,13 @@ module mld_s_jac_smoother
procedure, pass(sm) :: descr => s_jac_smoother_descr
procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => s_jac_smoother_get_nzeros
+ procedure, nopass :: get_fmt => s_jac_smoother_get_fmt
end type mld_s_jac_smoother_type
private :: s_jac_smoother_free, s_jac_smoother_descr, &
- & s_jac_smoother_sizeof, s_jac_smoother_get_nzeros
+ & s_jac_smoother_sizeof, s_jac_smoother_get_nzeros, &
+ & s_jac_smoother_get_fmt
interface
@@ -120,8 +122,8 @@ module mld_s_jac_smoother
subroutine mld_s_jac_smoother_clone(sm,smout,info)
import :: mld_s_jac_smoother_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
- class(mld_s_jac_smoother_type), intent(inout) :: sm
- class(mld_s_base_smoother_type), intent(out) :: smout
+ class(mld_s_jac_smoother_type), intent(inout) :: sm
+ class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_jac_smoother_clone
end interface
@@ -247,4 +249,11 @@ contains
return
end function s_jac_smoother_get_nzeros
+ function s_jac_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Jacobi smoother"
+ end function s_jac_smoother_get_fmt
+
end module mld_s_jac_smoother
diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90
index a161393f..e73530a7 100644
--- a/mlprec/mld_s_onelev_mod.f90
+++ b/mlprec/mld_s_onelev_mod.f90
@@ -385,11 +385,18 @@ contains
! Arguments
class(mld_s_onelev_type), target, intent(inout) :: lv
- class(mld_s_onelev_type), intent(out) :: lvout
+ class(mld_s_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
- if (allocated(lv%sm)) &
- & call lv%sm%clone(lvout%sm,info)
+ info = psb_success_
+ if (allocated(lv%sm)) then
+ call lv%sm%clone(lvout%sm,info)
+ else
+ if (allocated(lvout%sm)) then
+ call lvout%sm%free(info)
+ if (info==psb_success_) deallocate(lvout%sm,stat=info)
+ end if
+ end if
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90
index 78709141..65bb7c97 100644
--- a/mlprec/mld_s_prec_type.f90
+++ b/mlprec/mld_s_prec_type.f90
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_sprec_type), intent(inout) :: prec
- class(mld_sprec_type), target, intent(out) :: precout
- integer(psb_ipk_), intent(out) :: info
+ class(psb_sprec_type), intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
+
+ call mld_s_inner_clone(prec,precout,info)
+
+ end subroutine mld_s_clone
+
+ subroutine mld_s_inner_clone(prec,precout,info)
+
+ implicit none
+ class(mld_sprec_type), intent(inout) :: prec
+ class(psb_sprec_type), target, intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
- precout%ictxt = prec%ictxt
- precout%coarse_aggr_size = prec%coarse_aggr_size
- precout%op_complexity = prec%op_complexity
- if (allocated(prec%precv)) then
- ln = size(prec%precv)
- allocate(precout%precv(ln),stat=info)
- if (info /= psb_success_) goto 9999
- if (ln > 1) then
- call prec%precv(1)%clone(precout%precv(1),info)
- end if
- do lev=2, ln
- if (info /= psb_success_) exit
- call prec%precv(lev)%clone(precout%precv(lev),info)
- if (info == psb_success_) then
- precout%precv(lev)%base_a => precout%precv(lev)%ac
- precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
- precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
- precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+ select type(pout => precout)
+ class is (mld_sprec_type)
+ pout%ictxt = prec%ictxt
+ pout%coarse_aggr_size = prec%coarse_aggr_size
+ pout%op_complexity = prec%op_complexity
+ if (allocated(prec%precv)) then
+ ln = size(prec%precv)
+ allocate(pout%precv(ln),stat=info)
+ if (info /= psb_success_) goto 9999
+ if (ln >= 1) then
+ call prec%precv(1)%clone(pout%precv(1),info)
end if
- end do
- end if
+ do lev=2, ln
+ if (info /= psb_success_) exit
+ call prec%precv(lev)%clone(pout%precv(lev),info)
+ if (info == psb_success_) then
+ pout%precv(lev)%base_a => pout%precv(lev)%ac
+ pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
+ pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
+ pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
+ end if
+ end do
+ end if
+ class default
+ write(0,*) 'Error: wrong out type'
+ info = psb_err_invalid_input_
+ end select
9999 continue
- end subroutine mld_s_clone
+ end subroutine mld_s_inner_clone
subroutine mld_sprec_move_alloc(a, b,info)
use psb_base_mod
diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90
index 5d081ff1..717b4042 100644
--- a/mlprec/mld_z_as_smoother.f90
+++ b/mlprec/mld_z_as_smoother.f90
@@ -70,11 +70,13 @@ module mld_z_as_smoother
procedure, pass(sm) :: sizeof => z_as_smoother_sizeof
procedure, pass(sm) :: default => z_as_smoother_default
procedure, pass(sm) :: get_nzeros => z_as_smoother_get_nzeros
+ procedure, nopass :: get_fmt => z_as_smoother_get_fmt
end type mld_z_as_smoother_type
private :: z_as_smoother_descr, z_as_smoother_sizeof, &
- & z_as_smoother_default, z_as_smoother_get_nzeros
+ & z_as_smoother_default, z_as_smoother_get_nzeros, &
+ & z_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_z_as_smoother
subroutine mld_z_as_smoother_clone(sm,smout,info)
import :: mld_z_as_smoother_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
- class(mld_z_as_smoother_type), intent(inout) :: sm
- class(mld_z_base_smoother_type), intent(out) :: smout
+ class(mld_z_as_smoother_type), intent(inout) :: sm
+ class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_clone
end interface
@@ -352,4 +354,11 @@ contains
return
end subroutine z_as_smoother_descr
+ function z_as_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Schwarz smoother"
+ end function z_as_smoother_get_fmt
+
end module mld_z_as_smoother
diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90
index 882f68b5..a5c0a3df 100644
--- a/mlprec/mld_z_base_smoother_mod.f90
+++ b/mlprec/mld_z_base_smoother_mod.f90
@@ -112,10 +112,11 @@ module mld_z_base_smoother_mod
procedure, pass(sm) :: sizeof => z_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => z_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => z_base_smoother_get_fmt
end type mld_z_base_smoother_type
- private :: z_base_smoother_sizeof, &
+ private :: z_base_smoother_sizeof, z_base_smoother_get_fmt, &
& z_base_smoother_default, z_base_smoother_get_nzeros
@@ -304,8 +305,8 @@ module mld_z_base_smoother_mod
Implicit None
! Arguments
- class(mld_z_base_smoother_type), intent(inout) :: sm
- class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
+ class(mld_z_base_smoother_type), intent(inout) :: sm
+ class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_clone
end interface
@@ -357,5 +358,11 @@ contains
return
end subroutine z_base_smoother_default
+ function z_base_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base smoother"
+ end function z_base_smoother_get_fmt
end module mld_z_base_smoother_mod
diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90
index 4791306b..2de72c50 100644
--- a/mlprec/mld_z_base_solver_mod.f90
+++ b/mlprec/mld_z_base_solver_mod.f90
@@ -104,10 +104,11 @@ module mld_z_base_solver_mod
procedure, pass(sv) :: sizeof => z_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
+ procedure, nopass :: get_fmt => z_base_solver_get_fmt
end type mld_z_base_solver_type
private :: z_base_solver_sizeof, z_base_solver_default,&
- & z_base_solver_get_nzeros
+ & z_base_solver_get_nzeros, z_base_solver_get_fmt
interface
@@ -318,9 +319,9 @@ module mld_z_base_solver_mod
Implicit None
! Arguments
- class(mld_z_base_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_base_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_clone
end interface
@@ -360,4 +361,12 @@ contains
return
end subroutine z_base_solver_default
+ function z_base_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Base solver"
+ end function z_base_solver_get_fmt
+
+
end module mld_z_base_solver_mod
diff --git a/mlprec/mld_z_diag_solver.f90 b/mlprec/mld_z_diag_solver.f90
index 5701b44b..4184e99a 100644
--- a/mlprec/mld_z_diag_solver.f90
+++ b/mlprec/mld_z_diag_solver.f90
@@ -59,11 +59,13 @@ module mld_z_diag_solver
procedure, pass(sv) :: descr => z_diag_solver_descr
procedure, pass(sv) :: sizeof => z_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_diag_solver_get_nzeros
+ procedure, nopass :: get_fmt => z_diag_solver_get_fmt
end type mld_z_diag_solver_type
private :: z_diag_solver_free, z_diag_solver_descr, &
- & z_diag_solver_sizeof, z_diag_solver_get_nzeros
+ & z_diag_solver_sizeof, z_diag_solver_get_nzeros, &
+ & z_diag_solver_get_fmt
interface
@@ -122,9 +124,9 @@ module mld_z_diag_solver
Implicit None
! Arguments
- class(mld_z_diag_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_diag_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_diag_solver_clone
end interface
@@ -221,4 +223,12 @@ contains
return
end function z_diag_solver_get_nzeros
+ function z_diag_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Diag solver"
+ end function z_diag_solver_get_fmt
+
+
end module mld_z_diag_solver
diff --git a/mlprec/mld_z_id_solver.f90 b/mlprec/mld_z_id_solver.f90
index 1604e99e..53c81a29 100644
--- a/mlprec/mld_z_id_solver.f90
+++ b/mlprec/mld_z_id_solver.f90
@@ -55,11 +55,12 @@ module mld_z_id_solver
procedure, pass(sv) :: apply_a => mld_z_id_solver_apply
procedure, pass(sv) :: free => z_id_solver_free
procedure, pass(sv) :: descr => z_id_solver_descr
+ procedure, nopass :: get_fmt => z_id_solver_get_fmt
end type mld_z_id_solver_type
private :: z_id_solver_bld, &
- & z_id_solver_free, &
+ & z_id_solver_free, z_id_solver_get_fmt, &
& z_id_solver_descr
interface
@@ -102,9 +103,9 @@ module mld_z_id_solver
Implicit None
! Arguments
- class(mld_z_id_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_id_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_id_solver_clone
end interface
@@ -178,4 +179,12 @@ contains
end subroutine z_id_solver_descr
+ function z_id_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Identity solver"
+ end function z_id_solver_get_fmt
+
+
end module mld_z_id_solver
diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90
index 74e5789a..d4288e15 100644
--- a/mlprec/mld_z_ilu_solver.f90
+++ b/mlprec/mld_z_ilu_solver.f90
@@ -71,6 +71,7 @@ module mld_z_ilu_solver
procedure, pass(sv) :: default => z_ilu_solver_default
procedure, pass(sv) :: sizeof => z_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_ilu_solver_get_nzeros
+ procedure, nopass :: get_fmt => z_ilu_solver_get_fmt
end type mld_z_ilu_solver_type
@@ -79,7 +80,8 @@ module mld_z_ilu_solver
& z_ilu_solver_setc, z_ilu_solver_setr,&
& z_ilu_solver_descr, z_ilu_solver_sizeof, &
& z_ilu_solver_default, z_ilu_solver_dmp, &
- & z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros
+ & z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros, &
+ & z_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@@ -162,9 +164,9 @@ module mld_z_ilu_solver
Implicit None
! Arguments
- class(mld_z_ilu_solver_type), intent(inout) :: sv
- class(mld_z_base_solver_type), allocatable, intent(out) :: svout
- integer(psb_ipk_), intent(out) :: info
+ class(mld_z_ilu_solver_type), intent(inout) :: sv
+ class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
+ integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_ilu_solver_clone
end interface
@@ -556,4 +558,11 @@ contains
return
end function z_ilu_solver_sizeof
+ function z_ilu_solver_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "ILU solver"
+ end function z_ilu_solver_get_fmt
+
end module mld_z_ilu_solver
diff --git a/mlprec/mld_z_jac_smoother.f90 b/mlprec/mld_z_jac_smoother.f90
index 5d62897b..500c8aec 100644
--- a/mlprec/mld_z_jac_smoother.f90
+++ b/mlprec/mld_z_jac_smoother.f90
@@ -62,11 +62,13 @@ module mld_z_jac_smoother
procedure, pass(sm) :: descr => z_jac_smoother_descr
procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => z_jac_smoother_get_nzeros
+ procedure, nopass :: get_fmt => z_jac_smoother_get_fmt
end type mld_z_jac_smoother_type
private :: z_jac_smoother_free, z_jac_smoother_descr, &
- & z_jac_smoother_sizeof, z_jac_smoother_get_nzeros
+ & z_jac_smoother_sizeof, z_jac_smoother_get_nzeros, &
+ & z_jac_smoother_get_fmt
interface
@@ -120,8 +122,8 @@ module mld_z_jac_smoother
subroutine mld_z_jac_smoother_clone(sm,smout,info)
import :: mld_z_jac_smoother_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
- class(mld_z_jac_smoother_type), intent(inout) :: sm
- class(mld_z_base_smoother_type), intent(out) :: smout
+ class(mld_z_jac_smoother_type), intent(inout) :: sm
+ class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_jac_smoother_clone
end interface
@@ -247,4 +249,11 @@ contains
return
end function z_jac_smoother_get_nzeros
+ function z_jac_smoother_get_fmt() result(val)
+ implicit none
+ character(len=32) :: val
+
+ val = "Jacobi smoother"
+ end function z_jac_smoother_get_fmt
+
end module mld_z_jac_smoother
diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90
index 1da4d1d7..756effda 100644
--- a/mlprec/mld_z_onelev_mod.f90
+++ b/mlprec/mld_z_onelev_mod.f90
@@ -385,11 +385,18 @@ contains
! Arguments
class(mld_z_onelev_type), target, intent(inout) :: lv
- class(mld_z_onelev_type), intent(out) :: lvout
+ class(mld_z_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
- if (allocated(lv%sm)) &
- & call lv%sm%clone(lvout%sm,info)
+ info = psb_success_
+ if (allocated(lv%sm)) then
+ call lv%sm%clone(lvout%sm,info)
+ else
+ if (allocated(lvout%sm)) then
+ call lvout%sm%free(info)
+ if (info==psb_success_) deallocate(lvout%sm,stat=info)
+ end if
+ end if
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90
index 58160c94..1211f91c 100644
--- a/mlprec/mld_z_prec_type.f90
+++ b/mlprec/mld_z_prec_type.f90
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_zprec_type), intent(inout) :: prec
- class(mld_zprec_type), target, intent(out) :: precout
- integer(psb_ipk_), intent(out) :: info
+ class(psb_zprec_type), intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
+
+ call mld_z_inner_clone(prec,precout,info)
+
+ end subroutine mld_z_clone
+
+ subroutine mld_z_inner_clone(prec,precout,info)
+
+ implicit none
+ class(mld_zprec_type), intent(inout) :: prec
+ class(psb_zprec_type), target, intent(out) :: precout
+ integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
- precout%ictxt = prec%ictxt
- precout%coarse_aggr_size = prec%coarse_aggr_size
- precout%op_complexity = prec%op_complexity
- if (allocated(prec%precv)) then
- ln = size(prec%precv)
- allocate(precout%precv(ln),stat=info)
- if (info /= psb_success_) goto 9999
- if (ln > 1) then
- call prec%precv(1)%clone(precout%precv(1),info)
- end if
- do lev=2, ln
- if (info /= psb_success_) exit
- call prec%precv(lev)%clone(precout%precv(lev),info)
- if (info == psb_success_) then
- precout%precv(lev)%base_a => precout%precv(lev)%ac
- precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
- precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
- precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
+ select type(pout => precout)
+ class is (mld_zprec_type)
+ pout%ictxt = prec%ictxt
+ pout%coarse_aggr_size = prec%coarse_aggr_size
+ pout%op_complexity = prec%op_complexity
+ if (allocated(prec%precv)) then
+ ln = size(prec%precv)
+ allocate(pout%precv(ln),stat=info)
+ if (info /= psb_success_) goto 9999
+ if (ln >= 1) then
+ call prec%precv(1)%clone(pout%precv(1),info)
end if
- end do
- end if
+ do lev=2, ln
+ if (info /= psb_success_) exit
+ call prec%precv(lev)%clone(pout%precv(lev),info)
+ if (info == psb_success_) then
+ pout%precv(lev)%base_a => pout%precv(lev)%ac
+ pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
+ pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
+ pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
+ end if
+ end do
+ end if
+ class default
+ write(0,*) 'Error: wrong out type'
+ info = psb_err_invalid_input_
+ end select
9999 continue
- end subroutine mld_z_clone
+ end subroutine mld_z_inner_clone
subroutine mld_zprec_move_alloc(a, b,info)
use psb_base_mod