Corrected implementation of scale plus identity for sparse matrices

This commit is contained in:
Cirdans-Home
2020-04-14 18:56:22 +02:00
parent d22d15a0f4
commit 01f4f718de
20 changed files with 820 additions and 644 deletions
+54 -10
View File
@@ -1561,16 +1561,38 @@ subroutine psb_d_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
goto 9999
end if
call acoo%mv_to_fmt(a,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_fmt')
goto 9999
end if
call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_base_scalplusidentity
subroutine psb_d_base_scal(d,a,info,side)
@@ -3629,16 +3651,38 @@ subroutine psb_ld_base_scalplusidentity(d,a,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='ld_scalplusidentity'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: acoo
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call a%mv_to_coo(acoo,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_coo')
goto 9999
end if
call acoo%scalpid(d,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='scalpid')
goto 9999
end if
call acoo%mv_to_fmt(a,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='mv_to_fmt')
goto 9999
end if
call psb_error_handler(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_scalplusidentity
subroutine psb_ld_base_scal(d,a,info,side)