From 0aef02ca10e2a2d6565b7dd042e7b0ef00e4e8bf Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 10 May 2013 14:27:00 +0000 Subject: [PATCH] psblas3: base/modules/psb_c_linmap_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_s_linmap_mod.f90 base/modules/psb_z_linmap_mod.f90 Fix interface of clone. --- base/modules/psb_c_linmap_mod.f90 | 35 ++++++++++++++++++++++++------- base/modules/psb_d_linmap_mod.f90 | 35 ++++++++++++++++++++++++------- base/modules/psb_s_linmap_mod.f90 | 35 ++++++++++++++++++++++++------- base/modules/psb_z_linmap_mod.f90 | 35 ++++++++++++++++++++++++------- 4 files changed, 108 insertions(+), 32 deletions(-) diff --git a/base/modules/psb_c_linmap_mod.f90 b/base/modules/psb_c_linmap_mod.f90 index efb92e61..623f42a1 100644 --- a/base/modules/psb_c_linmap_mod.f90 +++ b/base/modules/psb_c_linmap_mod.f90 @@ -216,18 +216,37 @@ contains subroutine c_clone(map,mapout,info) use psb_desc_mod + use psb_error_mod implicit none class(psb_clinmap_type), intent(inout) :: map - class(psb_clinmap_type), intent(inout) :: mapout + class(psb_base_linmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info - call mapout%free(info) - ! Base clone! - 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) - + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name='clone' + + info = 0 + select type(mout => mapout) + class is (psb_clinmap_type) + call mout%free(info) + ! Base clone! + if (info == 0) call & + & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + class default + info = psb_err_invalid_dynamic_type_ + ierr(1) = 2 + info = psb_err_missing_override_method_ + call psb_errpush(info,name,i_err=ierr) + call psb_get_erraction(err_act) + if (err_act /= psb_act_ret_) then + call psb_error() + end if + end select + + end subroutine c_clone diff --git a/base/modules/psb_d_linmap_mod.f90 b/base/modules/psb_d_linmap_mod.f90 index 11cccdf5..92223e4f 100644 --- a/base/modules/psb_d_linmap_mod.f90 +++ b/base/modules/psb_d_linmap_mod.f90 @@ -216,18 +216,37 @@ contains subroutine d_clone(map,mapout,info) use psb_desc_mod + use psb_error_mod implicit none class(psb_dlinmap_type), intent(inout) :: map - class(psb_dlinmap_type), intent(inout) :: mapout + class(psb_base_linmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info - call mapout%free(info) - ! Base clone! - 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) - + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name='clone' + + info = 0 + select type(mout => mapout) + class is (psb_dlinmap_type) + call mout%free(info) + ! Base clone! + if (info == 0) call & + & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + class default + info = psb_err_invalid_dynamic_type_ + ierr(1) = 2 + info = psb_err_missing_override_method_ + call psb_errpush(info,name,i_err=ierr) + call psb_get_erraction(err_act) + if (err_act /= psb_act_ret_) then + call psb_error() + end if + end select + + end subroutine d_clone diff --git a/base/modules/psb_s_linmap_mod.f90 b/base/modules/psb_s_linmap_mod.f90 index d3b23ebd..44bd6cff 100644 --- a/base/modules/psb_s_linmap_mod.f90 +++ b/base/modules/psb_s_linmap_mod.f90 @@ -216,18 +216,37 @@ contains subroutine s_clone(map,mapout,info) use psb_desc_mod + use psb_error_mod implicit none class(psb_slinmap_type), intent(inout) :: map - class(psb_slinmap_type), intent(inout) :: mapout + class(psb_base_linmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info - call mapout%free(info) - ! Base clone! - 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) - + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name='clone' + + info = 0 + select type(mout => mapout) + class is (psb_slinmap_type) + call mout%free(info) + ! Base clone! + if (info == 0) call & + & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + class default + info = psb_err_invalid_dynamic_type_ + ierr(1) = 2 + info = psb_err_missing_override_method_ + call psb_errpush(info,name,i_err=ierr) + call psb_get_erraction(err_act) + if (err_act /= psb_act_ret_) then + call psb_error() + end if + end select + + end subroutine s_clone diff --git a/base/modules/psb_z_linmap_mod.f90 b/base/modules/psb_z_linmap_mod.f90 index 585eafab..ef1ec4b1 100644 --- a/base/modules/psb_z_linmap_mod.f90 +++ b/base/modules/psb_z_linmap_mod.f90 @@ -216,18 +216,37 @@ contains subroutine z_clone(map,mapout,info) use psb_desc_mod + use psb_error_mod implicit none class(psb_zlinmap_type), intent(inout) :: map - class(psb_zlinmap_type), intent(inout) :: mapout + class(psb_base_linmap_type), intent(inout) :: mapout integer(psb_ipk_) :: info - call mapout%free(info) - ! Base clone! - 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) - + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ierr(5) + character(len=20) :: name='clone' + + info = 0 + select type(mout => mapout) + class is (psb_zlinmap_type) + call mout%free(info) + ! Base clone! + if (info == 0) call & + & map%psb_base_linmap_type%clone(mout%psb_base_linmap_type,info) + if (info == 0) call map%map_X2Y%clone(mout%map_X2Y,info) + if (info == 0) call map%map_Y2X%clone(mout%map_Y2X,info) + class default + info = psb_err_invalid_dynamic_type_ + ierr(1) = 2 + info = psb_err_missing_override_method_ + call psb_errpush(info,name,i_err=ierr) + call psb_get_erraction(err_act) + if (err_act /= psb_act_ret_) then + call psb_error() + end if + end select + + end subroutine z_clone