fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-11 08:29:05 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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.
This commit is contained in:
Salvatore Filippone
2013-05-10 14:27:00 +00:00
parent 09f5576d73
commit 0aef02ca10
4 changed files with 104 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_c_linmap_mod.f90
+26 -7
View File
@@ -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
base/modules/psb_d_linmap_mod.f90
+26 -7
View File
@@ -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
base/modules/psb_s_linmap_mod.f90
+26 -7
View File
@@ -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
base/modules/psb_z_linmap_mod.f90
+26 -7
View File
@@ -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