fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Implementation of LXSPSP and to/from L/I.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 1031911a91
commit 9194f49f34
8 changed files with 728 additions and 152 deletions
Show Stats Download Patch File Download Diff File

139
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -2052,7 +2052,7 @@ subroutine psb_c_base_cp_from_lcoo(a,b,info)
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2086,11 +2086,12 @@ subroutine psb_c_base_cp_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2098,9 +2099,11 @@ subroutine psb_c_base_cp_to_lfmt(a,b,info)
type is (psb_lc_coo_sparse_mat)
call a%cp_to_lcoo(b,info)
class default
call a%cp_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -2128,8 +2131,8 @@ subroutine psb_c_base_cp_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -2140,8 +2143,9 @@ subroutine psb_c_base_cp_from_lfmt(a,b,info)
type is (psb_lc_coo_sparse_mat)
call a%cp_from_lcoo(b,info)
class default
call b%cp_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
@ -2153,7 +2157,6 @@ subroutine psb_c_base_cp_from_lfmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2191,7 +2194,6 @@ subroutine psb_c_base_mv_to_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2227,7 +2229,6 @@ subroutine psb_c_base_mv_from_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2247,20 +2248,35 @@ subroutine psb_c_base_mv_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_lc_coo_sparse_mat)
call a%mv_to_lcoo(b,info)
class default
call a%mv_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_mv_to_lfmt
@ -2277,19 +2293,33 @@ subroutine psb_c_base_mv_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_lc_coo_sparse_mat)
call a%mv_from_lcoo(b,info)
class default
call b%mv_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_mv_from_lfmt
@ -3758,7 +3788,8 @@ subroutine psb_lc_base_cp_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
@ -3770,9 +3801,11 @@ subroutine psb_lc_base_cp_to_ifmt(a,b,info)
type is (psb_c_coo_sparse_mat)
call a%cp_to_icoo(b,info)
class default
call a%cp_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -3800,8 +3833,8 @@ subroutine psb_lc_base_cp_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -3812,8 +3845,9 @@ subroutine psb_lc_base_cp_from_ifmt(a,b,info)
type is (psb_c_coo_sparse_mat)
call a%cp_from_icoo(b,info)
class default
call b%cp_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
@ -3825,7 +3859,6 @@ subroutine psb_lc_base_cp_from_ifmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -3919,20 +3952,35 @@ subroutine psb_lc_base_mv_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_c_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_c_coo_sparse_mat)
call a%mv_to_icoo(b,info)
class default
call a%mv_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_base_mv_to_ifmt
@ -3949,19 +3997,34 @@ subroutine psb_lc_base_mv_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_lc_coo_sparse_mat) :: tmp
type(psb_c_coo_sparse_mat) :: icoo
type(psb_lc_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_c_coo_sparse_mat)
call a%mv_from_icoo(b,info)
class default
call b%mv_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_base_mv_from_ifmt

139
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -2052,7 +2052,7 @@ subroutine psb_d_base_cp_from_lcoo(a,b,info)
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2086,11 +2086,12 @@ subroutine psb_d_base_cp_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2098,9 +2099,11 @@ subroutine psb_d_base_cp_to_lfmt(a,b,info)
type is (psb_ld_coo_sparse_mat)
call a%cp_to_lcoo(b,info)
class default
call a%cp_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -2128,8 +2131,8 @@ subroutine psb_d_base_cp_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -2140,8 +2143,9 @@ subroutine psb_d_base_cp_from_lfmt(a,b,info)
type is (psb_ld_coo_sparse_mat)
call a%cp_from_lcoo(b,info)
class default
call b%cp_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
@ -2153,7 +2157,6 @@ subroutine psb_d_base_cp_from_lfmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2191,7 +2194,6 @@ subroutine psb_d_base_mv_to_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2227,7 +2229,6 @@ subroutine psb_d_base_mv_from_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2247,20 +2248,35 @@ subroutine psb_d_base_mv_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_ld_coo_sparse_mat)
call a%mv_to_lcoo(b,info)
class default
call a%mv_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_base_mv_to_lfmt
@ -2277,19 +2293,33 @@ subroutine psb_d_base_mv_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_ld_coo_sparse_mat)
call a%mv_from_lcoo(b,info)
class default
call b%mv_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_base_mv_from_lfmt
@ -3758,7 +3788,8 @@ subroutine psb_ld_base_cp_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
@ -3770,9 +3801,11 @@ subroutine psb_ld_base_cp_to_ifmt(a,b,info)
type is (psb_d_coo_sparse_mat)
call a%cp_to_icoo(b,info)
class default
call a%cp_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -3800,8 +3833,8 @@ subroutine psb_ld_base_cp_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -3812,8 +3845,9 @@ subroutine psb_ld_base_cp_from_ifmt(a,b,info)
type is (psb_d_coo_sparse_mat)
call a%cp_from_icoo(b,info)
class default
call b%cp_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
@ -3825,7 +3859,6 @@ subroutine psb_ld_base_cp_from_ifmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -3919,20 +3952,35 @@ subroutine psb_ld_base_mv_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_d_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_d_coo_sparse_mat)
call a%mv_to_icoo(b,info)
class default
call a%mv_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_mv_to_ifmt
@ -3949,19 +3997,34 @@ subroutine psb_ld_base_mv_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_ld_coo_sparse_mat) :: tmp
type(psb_d_coo_sparse_mat) :: icoo
type(psb_ld_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_d_coo_sparse_mat)
call a%mv_from_icoo(b,info)
class default
call b%mv_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_base_mv_from_ifmt

139
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -2052,7 +2052,7 @@ subroutine psb_s_base_cp_from_lcoo(a,b,info)
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2086,11 +2086,12 @@ subroutine psb_s_base_cp_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2098,9 +2099,11 @@ subroutine psb_s_base_cp_to_lfmt(a,b,info)
type is (psb_ls_coo_sparse_mat)
call a%cp_to_lcoo(b,info)
class default
call a%cp_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -2128,8 +2131,8 @@ subroutine psb_s_base_cp_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -2140,8 +2143,9 @@ subroutine psb_s_base_cp_from_lfmt(a,b,info)
type is (psb_ls_coo_sparse_mat)
call a%cp_from_lcoo(b,info)
class default
call b%cp_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
@ -2153,7 +2157,6 @@ subroutine psb_s_base_cp_from_lfmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2191,7 +2194,6 @@ subroutine psb_s_base_mv_to_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2227,7 +2229,6 @@ subroutine psb_s_base_mv_from_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2247,20 +2248,35 @@ subroutine psb_s_base_mv_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_ls_coo_sparse_mat)
call a%mv_to_lcoo(b,info)
class default
call a%mv_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_base_mv_to_lfmt
@ -2277,19 +2293,33 @@ subroutine psb_s_base_mv_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_ls_coo_sparse_mat)
call a%mv_from_lcoo(b,info)
class default
call b%mv_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_base_mv_from_lfmt
@ -3758,7 +3788,8 @@ subroutine psb_ls_base_cp_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
@ -3770,9 +3801,11 @@ subroutine psb_ls_base_cp_to_ifmt(a,b,info)
type is (psb_s_coo_sparse_mat)
call a%cp_to_icoo(b,info)
class default
call a%cp_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -3800,8 +3833,8 @@ subroutine psb_ls_base_cp_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -3812,8 +3845,9 @@ subroutine psb_ls_base_cp_from_ifmt(a,b,info)
type is (psb_s_coo_sparse_mat)
call a%cp_from_icoo(b,info)
class default
call b%cp_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
@ -3825,7 +3859,6 @@ subroutine psb_ls_base_cp_from_ifmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -3919,20 +3952,35 @@ subroutine psb_ls_base_mv_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_s_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_s_coo_sparse_mat)
call a%mv_to_icoo(b,info)
class default
call a%mv_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_base_mv_to_ifmt
@ -3949,19 +3997,34 @@ subroutine psb_ls_base_mv_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_ls_coo_sparse_mat) :: tmp
type(psb_s_coo_sparse_mat) :: icoo
type(psb_ls_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_s_coo_sparse_mat)
call a%mv_from_icoo(b,info)
class default
call b%mv_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_base_mv_from_ifmt

139
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -2052,7 +2052,7 @@ subroutine psb_z_base_cp_from_lcoo(a,b,info)
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2086,11 +2086,12 @@ subroutine psb_z_base_cp_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
!
info = psb_success_
call psb_erractionsave(err_act)
@ -2098,9 +2099,11 @@ subroutine psb_z_base_cp_to_lfmt(a,b,info)
type is (psb_lz_coo_sparse_mat)
call a%cp_to_lcoo(b,info)
class default
call a%cp_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -2128,8 +2131,8 @@ subroutine psb_z_base_cp_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -2140,8 +2143,9 @@ subroutine psb_z_base_cp_from_lfmt(a,b,info)
type is (psb_lz_coo_sparse_mat)
call a%cp_from_lcoo(b,info)
class default
call b%cp_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
@ -2153,7 +2157,6 @@ subroutine psb_z_base_cp_from_lfmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2191,7 +2194,6 @@ subroutine psb_z_base_mv_to_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2227,7 +2229,6 @@ subroutine psb_z_base_mv_from_lcoo(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -2247,20 +2248,35 @@ subroutine psb_z_base_mv_to_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_lfmt'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_lz_coo_sparse_mat)
call a%mv_to_lcoo(b,info)
class default
call a%mv_to_lcoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call b%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_mv_to_lfmt
@ -2277,19 +2293,33 @@ subroutine psb_z_base_mv_from_lfmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_lfmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_lz_coo_sparse_mat)
call a%mv_from_lcoo(b,info)
class default
call b%mv_to_icoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call a%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_mv_from_lfmt
@ -3758,7 +3788,8 @@ subroutine psb_lz_base_cp_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
@ -3770,9 +3801,11 @@ subroutine psb_lz_base_cp_to_ifmt(a,b,info)
type is (psb_z_coo_sparse_mat)
call a%cp_to_icoo(b,info)
class default
call a%cp_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%cp_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
@ -3800,8 +3833,8 @@ subroutine psb_lz_base_cp_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
@ -3812,8 +3845,9 @@ subroutine psb_lz_base_cp_from_ifmt(a,b,info)
type is (psb_z_coo_sparse_mat)
call a%cp_from_icoo(b,info)
class default
call b%cp_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%cp_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
@ -3825,7 +3859,6 @@ subroutine psb_lz_base_cp_from_ifmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
@ -3919,20 +3952,35 @@ subroutine psb_lz_base_mv_to_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='to_ifmt'
logical, parameter :: debug=.false.
type(psb_z_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_z_coo_sparse_mat)
call a%mv_to_icoo(b,info)
class default
call a%mv_to_icoo(tmp,info)
if (info == psb_success_) call b%mv_from_coo(tmp,info)
call a%mv_to_coo(lcoo,info)
if (info == psb_success_) call lcoo%mv_to_icoo(icoo,info)
if (info == psb_success_) call b%mv_from_coo(icoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_base_mv_to_ifmt
@ -3949,19 +3997,34 @@ subroutine psb_lz_base_mv_from_ifmt(a,b,info)
integer(psb_ipk_) :: err_act
character(len=20) :: name='from_ifmt'
logical, parameter :: debug=.false.
type(psb_lz_coo_sparse_mat) :: tmp
type(psb_z_coo_sparse_mat) :: icoo
type(psb_lz_coo_sparse_mat) :: lcoo
!
! Default implementation
!
info = psb_success_
info = psb_success_
call psb_erractionsave(err_act)
select type(b)
type is (psb_z_coo_sparse_mat)
call a%mv_from_icoo(b,info)
class default
call b%mv_to_lcoo(tmp,info)
if (info == psb_success_) call a%mv_from_coo(tmp,info)
call b%mv_to_coo(icoo,info)
if (info == psb_success_) call icoo%mv_to_lcoo(lcoo,info)
if (info == psb_success_) call a%mv_from_coo(lcoo,info)
end select
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='to/from coo')
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_base_mv_from_ifmt

81
base/serial/psb_cspspmm.f90
Unescape Escape View File

@ -115,3 +115,84 @@ subroutine psb_cspspmm(a,b,c,info)
end subroutine psb_cspspmm
subroutine psb_lcspspmm(a,b,c,info)
use psb_base_mod, psb_protect_name => psb_lcspspmm
implicit none
type(psb_lcspmat_type), intent(in) :: a,b
type(psb_lcspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
type(psb_lc_csr_sparse_mat), allocatable :: ccsr
type(psb_lc_csc_sparse_mat), allocatable :: ccsc
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
if ((a%is_null()) .or.(b%is_null())) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
!
! Shortcuts for special cases
!
done_spmm = .false.
select type(aa=>a%a)
class is (psb_lc_csr_sparse_mat)
select type(ba=>b%a)
class is (psb_lc_csr_sparse_mat)
allocate(ccsr,stat=info)
if (info == psb_success_) then
call psb_lccsrspspmm(aa,ba,ccsr,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsr,c%a)
done_spmm = .true.
end select
class is (psb_lc_csc_sparse_mat)
select type(ba=>b%a)
class is (psb_lc_csc_sparse_mat)
allocate(ccsc,stat=info)
if (info == psb_success_) then
call psb_lccscspspmm(aa,ba,ccsc,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsc,c%a)
done_spmm = .true.
end select
end select
!
! General code
!
if (.not.done_spmm) then
call psb_symbmm(a,b,c,info)
if (info == psb_success_) call psb_numbmm(a,b,c)
end if
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lcspspmm

81
base/serial/psb_dspspmm.f90
Unescape Escape View File

@ -115,3 +115,84 @@ subroutine psb_dspspmm(a,b,c,info)
end subroutine psb_dspspmm
subroutine psb_ldspspmm(a,b,c,info)
use psb_base_mod, psb_protect_name => psb_ldspspmm
implicit none
type(psb_ldspmat_type), intent(in) :: a,b
type(psb_ldspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
type(psb_ld_csr_sparse_mat), allocatable :: ccsr
type(psb_ld_csc_sparse_mat), allocatable :: ccsc
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
if ((a%is_null()) .or.(b%is_null())) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
!
! Shortcuts for special cases
!
done_spmm = .false.
select type(aa=>a%a)
class is (psb_ld_csr_sparse_mat)
select type(ba=>b%a)
class is (psb_ld_csr_sparse_mat)
allocate(ccsr,stat=info)
if (info == psb_success_) then
call psb_ldcsrspspmm(aa,ba,ccsr,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsr,c%a)
done_spmm = .true.
end select
class is (psb_ld_csc_sparse_mat)
select type(ba=>b%a)
class is (psb_ld_csc_sparse_mat)
allocate(ccsc,stat=info)
if (info == psb_success_) then
call psb_ldcscspspmm(aa,ba,ccsc,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsc,c%a)
done_spmm = .true.
end select
end select
!
! General code
!
if (.not.done_spmm) then
call psb_symbmm(a,b,c,info)
if (info == psb_success_) call psb_numbmm(a,b,c)
end if
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ldspspmm

81
base/serial/psb_sspspmm.f90
Unescape Escape View File

@ -115,3 +115,84 @@ subroutine psb_sspspmm(a,b,c,info)
end subroutine psb_sspspmm
subroutine psb_lsspspmm(a,b,c,info)
use psb_base_mod, psb_protect_name => psb_lsspspmm
implicit none
type(psb_lsspmat_type), intent(in) :: a,b
type(psb_lsspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
type(psb_ls_csr_sparse_mat), allocatable :: ccsr
type(psb_ls_csc_sparse_mat), allocatable :: ccsc
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
if ((a%is_null()) .or.(b%is_null())) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
!
! Shortcuts for special cases
!
done_spmm = .false.
select type(aa=>a%a)
class is (psb_ls_csr_sparse_mat)
select type(ba=>b%a)
class is (psb_ls_csr_sparse_mat)
allocate(ccsr,stat=info)
if (info == psb_success_) then
call psb_lscsrspspmm(aa,ba,ccsr,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsr,c%a)
done_spmm = .true.
end select
class is (psb_ls_csc_sparse_mat)
select type(ba=>b%a)
class is (psb_ls_csc_sparse_mat)
allocate(ccsc,stat=info)
if (info == psb_success_) then
call psb_lscscspspmm(aa,ba,ccsc,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsc,c%a)
done_spmm = .true.
end select
end select
!
! General code
!
if (.not.done_spmm) then
call psb_symbmm(a,b,c,info)
if (info == psb_success_) call psb_numbmm(a,b,c)
end if
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lsspspmm

81
base/serial/psb_zspspmm.f90
Unescape Escape View File

@ -115,3 +115,84 @@ subroutine psb_zspspmm(a,b,c,info)
end subroutine psb_zspspmm
subroutine psb_lzspspmm(a,b,c,info)
use psb_base_mod, psb_protect_name => psb_lzspspmm
implicit none
type(psb_lzspmat_type), intent(in) :: a,b
type(psb_lzspmat_type), intent(out) :: c
integer(psb_ipk_), intent(out) :: info
type(psb_lz_csr_sparse_mat), allocatable :: ccsr
type(psb_lz_csc_sparse_mat), allocatable :: ccsc
integer(psb_ipk_) :: err_act
character(len=*), parameter :: name='psb_spspmm'
logical :: done_spmm
call psb_erractionsave(err_act)
info = psb_success_
if ((a%is_null()) .or.(b%is_null())) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
!
! Shortcuts for special cases
!
done_spmm = .false.
select type(aa=>a%a)
class is (psb_lz_csr_sparse_mat)
select type(ba=>b%a)
class is (psb_lz_csr_sparse_mat)
allocate(ccsr,stat=info)
if (info == psb_success_) then
call psb_lzcsrspspmm(aa,ba,ccsr,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsr,c%a)
done_spmm = .true.
end select
class is (psb_lz_csc_sparse_mat)
select type(ba=>b%a)
class is (psb_lz_csc_sparse_mat)
allocate(ccsc,stat=info)
if (info == psb_success_) then
call psb_lzcscspspmm(aa,ba,ccsc,info)
else
info = psb_err_alloc_dealloc_
end if
if (info == psb_success_) call move_alloc(ccsc,c%a)
done_spmm = .true.
end select
end select
!
! General code
!
if (.not.done_spmm) then
call psb_symbmm(a,b,c,info)
if (info == psb_success_) call psb_numbmm(a,b,c)
end if
if (info /= psb_success_) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lzspspmm

Write Preview
Loading…
Cancel
Save