From 9f4a8ca232ceca1ae827871d0d5eac699690c8dd Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 9 Apr 2013 08:09:25 +0000 Subject: [PATCH] psblas3: base/modules/psb_base_linmap_mod.f90 base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_linmap_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_linmap_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_linmap_mod.f90 base/modules/psb_z_mat_mod.f90 base/serial/impl/psb_c_mat_impl.F90 base/serial/impl/psb_d_mat_impl.F90 base/serial/impl/psb_s_mat_impl.F90 base/serial/impl/psb_z_mat_impl.F90 prec/psb_c_base_prec_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_diagprec.f90 prec/psb_c_nullprec.f90 prec/psb_c_prec_type.f90 prec/psb_d_base_prec_mod.f90 prec/psb_d_bjacprec.f90 prec/psb_d_diagprec.f90 prec/psb_d_nullprec.f90 prec/psb_d_prec_type.f90 prec/psb_s_base_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_diagprec.f90 prec/psb_s_nullprec.f90 prec/psb_s_prec_type.f90 prec/psb_z_base_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_diagprec.f90 prec/psb_z_nullprec.f90 prec/psb_z_prec_type.f90 INTENT of arguments of clone methods --- base/modules/psb_base_linmap_mod.f90 | 4 ++-- base/modules/psb_c_base_mat_mod.f90 | 2 +- base/modules/psb_c_linmap_mod.f90 | 10 ++++++---- base/modules/psb_c_mat_mod.f90 | 2 +- base/modules/psb_d_base_mat_mod.f90 | 2 +- base/modules/psb_d_linmap_mod.f90 | 10 ++++++---- base/modules/psb_d_mat_mod.f90 | 2 +- base/modules/psb_s_base_mat_mod.f90 | 2 +- base/modules/psb_s_linmap_mod.f90 | 10 ++++++---- base/modules/psb_s_mat_mod.f90 | 2 +- base/modules/psb_z_base_mat_mod.f90 | 2 +- base/modules/psb_z_linmap_mod.f90 | 10 ++++++---- base/modules/psb_z_mat_mod.f90 | 2 +- base/serial/impl/psb_c_mat_impl.F90 | 4 ++-- base/serial/impl/psb_d_mat_impl.F90 | 4 ++-- base/serial/impl/psb_s_mat_impl.F90 | 4 ++-- base/serial/impl/psb_z_mat_impl.F90 | 4 ++-- prec/psb_c_base_prec_mod.f90 | 4 ++-- prec/psb_c_bjacprec.f90 | 11 ++++++++--- prec/psb_c_diagprec.f90 | 9 +++++++-- prec/psb_c_nullprec.f90 | 9 +++++++-- prec/psb_c_prec_type.f90 | 4 ++-- prec/psb_d_base_prec_mod.f90 | 4 ++-- prec/psb_d_bjacprec.f90 | 11 ++++++++--- prec/psb_d_diagprec.f90 | 9 +++++++-- prec/psb_d_nullprec.f90 | 9 +++++++-- prec/psb_d_prec_type.f90 | 4 ++-- prec/psb_s_base_prec_mod.f90 | 4 ++-- prec/psb_s_bjacprec.f90 | 11 ++++++++--- prec/psb_s_diagprec.f90 | 9 +++++++-- prec/psb_s_nullprec.f90 | 9 +++++++-- prec/psb_s_prec_type.f90 | 4 ++-- prec/psb_z_base_prec_mod.f90 | 4 ++-- prec/psb_z_bjacprec.f90 | 11 ++++++++--- prec/psb_z_diagprec.f90 | 9 +++++++-- prec/psb_z_nullprec.f90 | 9 +++++++-- prec/psb_z_prec_type.f90 | 4 ++-- 37 files changed, 146 insertions(+), 78 deletions(-) diff --git a/base/modules/psb_base_linmap_mod.f90 b/base/modules/psb_base_linmap_mod.f90 index 6f5025a4..fc5cda9e 100644 --- a/base/modules/psb_base_linmap_mod.f90 +++ b/base/modules/psb_base_linmap_mod.f90 @@ -163,9 +163,9 @@ contains use psb_realloc_mod implicit none class(psb_base_linmap_type), intent(inout) :: map - class(psb_base_linmap_type), intent(out) :: mapout + class(psb_base_linmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info - + mapout%kind = map%kind call psb_safe_ab_cpy(map%iaggr,mapout%iaggr,info) call psb_safe_ab_cpy(map%naggr,mapout%naggr,info) diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index 8dbbbb4b..8c8a60a9 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -63,7 +63,6 @@ module psb_c_base_mat_mod procedure, pass(a) :: get_diag => psb_c_base_get_diag generic, public :: csget => csgetrow, csgetblk procedure, pass(a) :: csclip => psb_c_base_csclip - procedure, pass(a) :: mold => psb_c_base_mold procedure, pass(a) :: cp_to_coo => psb_c_base_cp_to_coo procedure, pass(a) :: cp_from_coo => psb_c_base_cp_from_coo procedure, pass(a) :: cp_to_fmt => psb_c_base_cp_to_fmt @@ -76,6 +75,7 @@ module psb_c_base_mat_mod generic, public :: cp_from => c_base_cp_from procedure, pass(a) :: c_base_mv_from generic, public :: mv_from => c_base_mv_from + procedure, pass(a) :: mold => psb_c_base_mold procedure, pass(a) :: clone => psb_c_base_clone ! diff --git a/base/modules/psb_c_linmap_mod.f90 b/base/modules/psb_c_linmap_mod.f90 index af3ee151..2bc16326 100644 --- a/base/modules/psb_c_linmap_mod.f90 +++ b/base/modules/psb_c_linmap_mod.f90 @@ -218,13 +218,15 @@ contains use psb_desc_mod implicit none class(psb_clinmap_type), intent(inout) :: map - class(psb_clinmap_type), intent(out) :: mapout + class(psb_clinmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info + call mapout%free(info) ! Base clone! - call map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) - call map%map_X2Y%clone(mapout%map_X2Y,info) - call map%map_Y2X%clone(mapout%map_Y2X,info) + if (info == 0) call & + & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info) end subroutine c_clone diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index 34d266d0..aa623bef 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/base/modules/psb_c_mat_mod.f90 @@ -613,7 +613,7 @@ module psb_c_mat_mod subroutine psb_cspmat_clone(a,b,info) import :: psb_ipk_, psb_cspmat_type class(psb_cspmat_type), intent(inout) :: a - class(psb_cspmat_type), intent(out) :: b + class(psb_cspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_cspmat_clone end interface diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index d29288a8..828a52ef 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -63,7 +63,6 @@ module psb_d_base_mat_mod procedure, pass(a) :: get_diag => psb_d_base_get_diag generic, public :: csget => csgetrow, csgetblk procedure, pass(a) :: csclip => psb_d_base_csclip - procedure, pass(a) :: mold => psb_d_base_mold procedure, pass(a) :: cp_to_coo => psb_d_base_cp_to_coo procedure, pass(a) :: cp_from_coo => psb_d_base_cp_from_coo procedure, pass(a) :: cp_to_fmt => psb_d_base_cp_to_fmt @@ -76,6 +75,7 @@ module psb_d_base_mat_mod generic, public :: cp_from => d_base_cp_from procedure, pass(a) :: d_base_mv_from generic, public :: mv_from => d_base_mv_from + procedure, pass(a) :: mold => psb_d_base_mold procedure, pass(a) :: clone => psb_d_base_clone ! diff --git a/base/modules/psb_d_linmap_mod.f90 b/base/modules/psb_d_linmap_mod.f90 index bdb1b3dd..3066e922 100644 --- a/base/modules/psb_d_linmap_mod.f90 +++ b/base/modules/psb_d_linmap_mod.f90 @@ -218,13 +218,15 @@ contains use psb_desc_mod implicit none class(psb_dlinmap_type), intent(inout) :: map - class(psb_dlinmap_type), intent(out) :: mapout + class(psb_dlinmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info + call mapout%free(info) ! Base clone! - call map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) - call map%map_X2Y%clone(mapout%map_X2Y,info) - call map%map_Y2X%clone(mapout%map_Y2X,info) + if (info == 0) call & + & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info) end subroutine d_clone diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 7b706a85..6b141744 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/base/modules/psb_d_mat_mod.f90 @@ -613,7 +613,7 @@ module psb_d_mat_mod subroutine psb_dspmat_clone(a,b,info) import :: psb_ipk_, psb_dspmat_type class(psb_dspmat_type), intent(inout) :: a - class(psb_dspmat_type), intent(out) :: b + class(psb_dspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_dspmat_clone end interface diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 5b8e7b84..c6f441d5 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -63,7 +63,6 @@ module psb_s_base_mat_mod procedure, pass(a) :: get_diag => psb_s_base_get_diag generic, public :: csget => csgetrow, csgetblk procedure, pass(a) :: csclip => psb_s_base_csclip - procedure, pass(a) :: mold => psb_s_base_mold procedure, pass(a) :: cp_to_coo => psb_s_base_cp_to_coo procedure, pass(a) :: cp_from_coo => psb_s_base_cp_from_coo procedure, pass(a) :: cp_to_fmt => psb_s_base_cp_to_fmt @@ -76,6 +75,7 @@ module psb_s_base_mat_mod generic, public :: cp_from => s_base_cp_from procedure, pass(a) :: s_base_mv_from generic, public :: mv_from => s_base_mv_from + procedure, pass(a) :: mold => psb_s_base_mold procedure, pass(a) :: clone => psb_s_base_clone ! diff --git a/base/modules/psb_s_linmap_mod.f90 b/base/modules/psb_s_linmap_mod.f90 index c0a52418..91f8cc6c 100644 --- a/base/modules/psb_s_linmap_mod.f90 +++ b/base/modules/psb_s_linmap_mod.f90 @@ -218,13 +218,15 @@ contains use psb_desc_mod implicit none class(psb_slinmap_type), intent(inout) :: map - class(psb_slinmap_type), intent(out) :: mapout + class(psb_slinmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info + call mapout%free(info) ! Base clone! - call map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) - call map%map_X2Y%clone(mapout%map_X2Y,info) - call map%map_Y2X%clone(mapout%map_Y2X,info) + if (info == 0) call & + & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info) end subroutine s_clone diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 38795dd9..420ec535 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/base/modules/psb_s_mat_mod.f90 @@ -613,7 +613,7 @@ module psb_s_mat_mod subroutine psb_sspmat_clone(a,b,info) import :: psb_ipk_, psb_sspmat_type class(psb_sspmat_type), intent(inout) :: a - class(psb_sspmat_type), intent(out) :: b + class(psb_sspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_sspmat_clone end interface diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 49b6c920..33803f80 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -63,7 +63,6 @@ module psb_z_base_mat_mod procedure, pass(a) :: get_diag => psb_z_base_get_diag generic, public :: csget => csgetrow, csgetblk procedure, pass(a) :: csclip => psb_z_base_csclip - procedure, pass(a) :: mold => psb_z_base_mold procedure, pass(a) :: cp_to_coo => psb_z_base_cp_to_coo procedure, pass(a) :: cp_from_coo => psb_z_base_cp_from_coo procedure, pass(a) :: cp_to_fmt => psb_z_base_cp_to_fmt @@ -76,6 +75,7 @@ module psb_z_base_mat_mod generic, public :: cp_from => z_base_cp_from procedure, pass(a) :: z_base_mv_from generic, public :: mv_from => z_base_mv_from + procedure, pass(a) :: mold => psb_z_base_mold procedure, pass(a) :: clone => psb_z_base_clone ! diff --git a/base/modules/psb_z_linmap_mod.f90 b/base/modules/psb_z_linmap_mod.f90 index 34bcc05d..3c5a7124 100644 --- a/base/modules/psb_z_linmap_mod.f90 +++ b/base/modules/psb_z_linmap_mod.f90 @@ -218,13 +218,15 @@ contains use psb_desc_mod implicit none class(psb_zlinmap_type), intent(inout) :: map - class(psb_zlinmap_type), intent(out) :: mapout + class(psb_zlinmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info + call mapout%free(info) ! Base clone! - call map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) - call map%map_X2Y%clone(mapout%map_X2Y,info) - call map%map_Y2X%clone(mapout%map_Y2X,info) + if (info == 0) call & + & map%psb_base_linmap_type%clone(mapout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mapout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mapout%map_Y2X,info) end subroutine z_clone diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index af092bcb..f53d2143 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/base/modules/psb_z_mat_mod.f90 @@ -613,7 +613,7 @@ module psb_z_mat_mod subroutine psb_zspmat_clone(a,b,info) import :: psb_ipk_, psb_zspmat_type class(psb_zspmat_type), intent(inout) :: a - class(psb_zspmat_type), intent(out) :: b + class(psb_zspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info end subroutine psb_zspmat_clone end interface diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 69a900d0..817171f8 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -1545,7 +1545,7 @@ subroutine psb_cspmat_clone(a,b,info) use psb_c_mat_mod, psb_protect_name => psb_cspmat_clone implicit none class(psb_cspmat_type), intent(inout) :: a - class(psb_cspmat_type), intent(out) :: b + class(psb_cspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1554,7 +1554,7 @@ subroutine psb_cspmat_clone(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - + call b%free() if (allocated(a%a)) then call a%a%clone(b%a,info) end if diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index a557ee46..7a035ba3 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1545,7 +1545,7 @@ subroutine psb_dspmat_clone(a,b,info) use psb_d_mat_mod, psb_protect_name => psb_dspmat_clone implicit none class(psb_dspmat_type), intent(inout) :: a - class(psb_dspmat_type), intent(out) :: b + class(psb_dspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1554,7 +1554,7 @@ subroutine psb_dspmat_clone(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - + call b%free() if (allocated(a%a)) then call a%a%clone(b%a,info) end if diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 5bc7471e..1ee1561a 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -1545,7 +1545,7 @@ subroutine psb_sspmat_clone(a,b,info) use psb_s_mat_mod, psb_protect_name => psb_sspmat_clone implicit none class(psb_sspmat_type), intent(inout) :: a - class(psb_sspmat_type), intent(out) :: b + class(psb_sspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1554,7 +1554,7 @@ subroutine psb_sspmat_clone(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - + call b%free() if (allocated(a%a)) then call a%a%clone(b%a,info) end if diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 0438fdb8..2e3e2819 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -1545,7 +1545,7 @@ subroutine psb_zspmat_clone(a,b,info) use psb_z_mat_mod, psb_protect_name => psb_zspmat_clone implicit none class(psb_zspmat_type), intent(inout) :: a - class(psb_zspmat_type), intent(out) :: b + class(psb_zspmat_type), intent(inout) :: b integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1554,7 +1554,7 @@ subroutine psb_zspmat_clone(a,b,info) call psb_erractionsave(err_act) info = psb_success_ - + call b%free() if (allocated(a%a)) then call a%a%clone(b%a,info) end if diff --git a/prec/psb_c_base_prec_mod.f90 b/prec/psb_c_base_prec_mod.f90 index 853c3669..e7d52f62 100644 --- a/prec/psb_c_base_prec_mod.f90 +++ b/prec/psb_c_base_prec_mod.f90 @@ -187,8 +187,8 @@ module psb_c_base_prec_mod & psb_c_base_vect_type, psb_cspmat_type, psb_c_base_prec_type,& & psb_c_base_sparse_mat implicit none - class(psb_c_base_prec_type), intent(inout) :: prec - class(psb_c_base_prec_type), allocatable, intent(out) :: precout + class(psb_c_base_prec_type), intent(inout) :: prec + class(psb_c_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info end subroutine psb_c_base_precclone end interface diff --git a/prec/psb_c_bjacprec.f90 b/prec/psb_c_bjacprec.f90 index f6183405..19d1fa52 100644 --- a/prec/psb_c_bjacprec.f90 +++ b/prec/psb_c_bjacprec.f90 @@ -257,8 +257,8 @@ contains use psb_realloc_mod Implicit None - class(psb_c_bjac_prec_type), intent(inout) :: prec - class(psb_c_base_prec_type), allocatable, intent(out) :: precout + class(psb_c_bjac_prec_type), intent(inout) :: prec + class(psb_c_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -267,7 +267,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_c_bjac_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_c_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_c_bjac_prec_type) diff --git a/prec/psb_c_diagprec.f90 b/prec/psb_c_diagprec.f90 index 8d7525dc..868b4e6a 100644 --- a/prec/psb_c_diagprec.f90 +++ b/prec/psb_c_diagprec.f90 @@ -233,7 +233,7 @@ contains Implicit None class(psb_c_diag_prec_type), intent(inout) :: prec - class(psb_c_base_prec_type), allocatable, intent(out) :: precout + class(psb_c_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -242,7 +242,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_c_diag_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_c_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_c_diag_prec_type) diff --git a/prec/psb_c_nullprec.f90 b/prec/psb_c_nullprec.f90 index ca39708d..e2268d58 100644 --- a/prec/psb_c_nullprec.f90 +++ b/prec/psb_c_nullprec.f90 @@ -267,7 +267,7 @@ contains Implicit None class(psb_c_null_prec_type), intent(inout) :: prec - class(psb_c_base_prec_type), allocatable, intent(out) :: precout + class(psb_c_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -276,7 +276,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_c_null_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_c_null_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_c_null_prec_type) diff --git a/prec/psb_c_prec_type.f90 b/prec/psb_c_prec_type.f90 index e1b42f0d..6586c0c3 100644 --- a/prec/psb_c_prec_type.f90 +++ b/prec/psb_c_prec_type.f90 @@ -232,11 +232,11 @@ contains subroutine psb_c_prec_clone(prec,precout,info) implicit none class(psb_cprec_type), intent(inout) :: prec - class(psb_cprec_type), intent(out) :: precout + class(psb_cprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info info = psb_success_ - + call prec%free(info) if (allocated(prec%prec)) then call prec%prec%clone(precout%prec,info) end if diff --git a/prec/psb_d_base_prec_mod.f90 b/prec/psb_d_base_prec_mod.f90 index eae724fe..58668384 100644 --- a/prec/psb_d_base_prec_mod.f90 +++ b/prec/psb_d_base_prec_mod.f90 @@ -187,8 +187,8 @@ module psb_d_base_prec_mod & psb_d_base_vect_type, psb_dspmat_type, psb_d_base_prec_type,& & psb_d_base_sparse_mat implicit none - class(psb_d_base_prec_type), intent(inout) :: prec - class(psb_d_base_prec_type), allocatable, intent(out) :: precout + class(psb_d_base_prec_type), intent(inout) :: prec + class(psb_d_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info end subroutine psb_d_base_precclone end interface diff --git a/prec/psb_d_bjacprec.f90 b/prec/psb_d_bjacprec.f90 index 8ca1b445..85bd3c61 100644 --- a/prec/psb_d_bjacprec.f90 +++ b/prec/psb_d_bjacprec.f90 @@ -257,8 +257,8 @@ contains use psb_realloc_mod Implicit None - class(psb_d_bjac_prec_type), intent(inout) :: prec - class(psb_d_base_prec_type), allocatable, intent(out) :: precout + class(psb_d_bjac_prec_type), intent(inout) :: prec + class(psb_d_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -267,7 +267,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_d_bjac_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_d_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_d_bjac_prec_type) diff --git a/prec/psb_d_diagprec.f90 b/prec/psb_d_diagprec.f90 index 1fd2ac3e..da93941f 100644 --- a/prec/psb_d_diagprec.f90 +++ b/prec/psb_d_diagprec.f90 @@ -233,7 +233,7 @@ contains Implicit None class(psb_d_diag_prec_type), intent(inout) :: prec - class(psb_d_base_prec_type), allocatable, intent(out) :: precout + class(psb_d_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -242,7 +242,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_d_diag_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_d_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_d_diag_prec_type) diff --git a/prec/psb_d_nullprec.f90 b/prec/psb_d_nullprec.f90 index 0a87cf5e..1016681c 100644 --- a/prec/psb_d_nullprec.f90 +++ b/prec/psb_d_nullprec.f90 @@ -267,7 +267,7 @@ contains Implicit None class(psb_d_null_prec_type), intent(inout) :: prec - class(psb_d_base_prec_type), allocatable, intent(out) :: precout + class(psb_d_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -276,7 +276,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_d_null_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_d_null_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_d_null_prec_type) diff --git a/prec/psb_d_prec_type.f90 b/prec/psb_d_prec_type.f90 index 8eb12158..789c4ebe 100644 --- a/prec/psb_d_prec_type.f90 +++ b/prec/psb_d_prec_type.f90 @@ -232,11 +232,11 @@ contains subroutine psb_d_prec_clone(prec,precout,info) implicit none class(psb_dprec_type), intent(inout) :: prec - class(psb_dprec_type), intent(out) :: precout + class(psb_dprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info info = psb_success_ - + call prec%free(info) if (allocated(prec%prec)) then call prec%prec%clone(precout%prec,info) end if diff --git a/prec/psb_s_base_prec_mod.f90 b/prec/psb_s_base_prec_mod.f90 index f40a17b5..cad70f2e 100644 --- a/prec/psb_s_base_prec_mod.f90 +++ b/prec/psb_s_base_prec_mod.f90 @@ -187,8 +187,8 @@ module psb_s_base_prec_mod & psb_s_base_vect_type, psb_sspmat_type, psb_s_base_prec_type,& & psb_s_base_sparse_mat implicit none - class(psb_s_base_prec_type), intent(inout) :: prec - class(psb_s_base_prec_type), allocatable, intent(out) :: precout + class(psb_s_base_prec_type), intent(inout) :: prec + class(psb_s_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info end subroutine psb_s_base_precclone end interface diff --git a/prec/psb_s_bjacprec.f90 b/prec/psb_s_bjacprec.f90 index 8e6b831a..5b48d68b 100644 --- a/prec/psb_s_bjacprec.f90 +++ b/prec/psb_s_bjacprec.f90 @@ -257,8 +257,8 @@ contains use psb_realloc_mod Implicit None - class(psb_s_bjac_prec_type), intent(inout) :: prec - class(psb_s_base_prec_type), allocatable, intent(out) :: precout + class(psb_s_bjac_prec_type), intent(inout) :: prec + class(psb_s_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -267,7 +267,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_s_bjac_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_s_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_s_bjac_prec_type) diff --git a/prec/psb_s_diagprec.f90 b/prec/psb_s_diagprec.f90 index 49452988..f7ae1491 100644 --- a/prec/psb_s_diagprec.f90 +++ b/prec/psb_s_diagprec.f90 @@ -233,7 +233,7 @@ contains Implicit None class(psb_s_diag_prec_type), intent(inout) :: prec - class(psb_s_base_prec_type), allocatable, intent(out) :: precout + class(psb_s_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -242,7 +242,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_s_diag_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_s_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_s_diag_prec_type) diff --git a/prec/psb_s_nullprec.f90 b/prec/psb_s_nullprec.f90 index f15a58fa..ee3006db 100644 --- a/prec/psb_s_nullprec.f90 +++ b/prec/psb_s_nullprec.f90 @@ -267,7 +267,7 @@ contains Implicit None class(psb_s_null_prec_type), intent(inout) :: prec - class(psb_s_base_prec_type), allocatable, intent(out) :: precout + class(psb_s_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -276,7 +276,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_s_null_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_s_null_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_s_null_prec_type) diff --git a/prec/psb_s_prec_type.f90 b/prec/psb_s_prec_type.f90 index bcbdc1af..903aa540 100644 --- a/prec/psb_s_prec_type.f90 +++ b/prec/psb_s_prec_type.f90 @@ -232,11 +232,11 @@ contains subroutine psb_s_prec_clone(prec,precout,info) implicit none class(psb_sprec_type), intent(inout) :: prec - class(psb_sprec_type), intent(out) :: precout + class(psb_sprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info info = psb_success_ - + call prec%free(info) if (allocated(prec%prec)) then call prec%prec%clone(precout%prec,info) end if diff --git a/prec/psb_z_base_prec_mod.f90 b/prec/psb_z_base_prec_mod.f90 index 77604691..fa826586 100644 --- a/prec/psb_z_base_prec_mod.f90 +++ b/prec/psb_z_base_prec_mod.f90 @@ -187,8 +187,8 @@ module psb_z_base_prec_mod & psb_z_base_vect_type, psb_zspmat_type, psb_z_base_prec_type,& & psb_z_base_sparse_mat implicit none - class(psb_z_base_prec_type), intent(inout) :: prec - class(psb_z_base_prec_type), allocatable, intent(out) :: precout + class(psb_z_base_prec_type), intent(inout) :: prec + class(psb_z_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info end subroutine psb_z_base_precclone end interface diff --git a/prec/psb_z_bjacprec.f90 b/prec/psb_z_bjacprec.f90 index c7a984f8..45f9995b 100644 --- a/prec/psb_z_bjacprec.f90 +++ b/prec/psb_z_bjacprec.f90 @@ -257,8 +257,8 @@ contains use psb_realloc_mod Implicit None - class(psb_z_bjac_prec_type), intent(inout) :: prec - class(psb_z_base_prec_type), allocatable, intent(out) :: precout + class(psb_z_bjac_prec_type), intent(inout) :: prec + class(psb_z_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -267,7 +267,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_z_bjac_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_z_bjac_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_z_bjac_prec_type) diff --git a/prec/psb_z_diagprec.f90 b/prec/psb_z_diagprec.f90 index 409447ac..1ccf95e0 100644 --- a/prec/psb_z_diagprec.f90 +++ b/prec/psb_z_diagprec.f90 @@ -233,7 +233,7 @@ contains Implicit None class(psb_z_diag_prec_type), intent(inout) :: prec - class(psb_z_base_prec_type), allocatable, intent(out) :: precout + class(psb_z_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -242,7 +242,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_z_diag_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_z_diag_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_z_diag_prec_type) diff --git a/prec/psb_z_nullprec.f90 b/prec/psb_z_nullprec.f90 index 21ffff86..6affb709 100644 --- a/prec/psb_z_nullprec.f90 +++ b/prec/psb_z_nullprec.f90 @@ -267,7 +267,7 @@ contains Implicit None class(psb_z_null_prec_type), intent(inout) :: prec - class(psb_z_base_prec_type), allocatable, intent(out) :: precout + class(psb_z_base_prec_type), allocatable, intent(inout) :: precout integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act, i @@ -276,7 +276,12 @@ contains call psb_erractionsave(err_act) info = psb_success_ - allocate(psb_z_null_prec_type :: precout, stat=info) + if (allocated(precout)) then + call precout%free(info) + if (info == psb_success_) deallocate(precout, stat=info) + end if + if (info == psb_success_) & + & allocate(psb_z_null_prec_type :: precout, stat=info) if (info /= 0) goto 9999 select type(pout => precout) type is (psb_z_null_prec_type) diff --git a/prec/psb_z_prec_type.f90 b/prec/psb_z_prec_type.f90 index 0f5297f7..d5d0a177 100644 --- a/prec/psb_z_prec_type.f90 +++ b/prec/psb_z_prec_type.f90 @@ -232,11 +232,11 @@ contains subroutine psb_z_prec_clone(prec,precout,info) implicit none class(psb_zprec_type), intent(inout) :: prec - class(psb_zprec_type), intent(out) :: precout + class(psb_zprec_type), intent(inout) :: precout integer(psb_ipk_), intent(out) :: info info = psb_success_ - + call prec%free(info) if (allocated(prec%prec)) then call prec%prec%clone(precout%prec,info) end if