diff --git a/base/serial/impl/psb_c_base_mat_impl.F90 b/base/serial/impl/psb_c_base_mat_impl.F90 index 39edf7a7..804e7058 100644 --- a/base/serial/impl/psb_c_base_mat_impl.F90 +++ b/base/serial/impl/psb_c_base_mat_impl.F90 @@ -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 diff --git a/base/serial/impl/psb_d_base_mat_impl.F90 b/base/serial/impl/psb_d_base_mat_impl.F90 index dc0fe044..f359dbe8 100644 --- a/base/serial/impl/psb_d_base_mat_impl.F90 +++ b/base/serial/impl/psb_d_base_mat_impl.F90 @@ -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 diff --git a/base/serial/impl/psb_s_base_mat_impl.F90 b/base/serial/impl/psb_s_base_mat_impl.F90 index 51be627e..a5ed5df0 100644 --- a/base/serial/impl/psb_s_base_mat_impl.F90 +++ b/base/serial/impl/psb_s_base_mat_impl.F90 @@ -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 diff --git a/base/serial/impl/psb_z_base_mat_impl.F90 b/base/serial/impl/psb_z_base_mat_impl.F90 index 9dea7fb2..17223e24 100644 --- a/base/serial/impl/psb_z_base_mat_impl.F90 +++ b/base/serial/impl/psb_z_base_mat_impl.F90 @@ -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 diff --git a/base/serial/psb_cspspmm.f90 b/base/serial/psb_cspspmm.f90 index d54dde98..ef56757e 100644 --- a/base/serial/psb_cspspmm.f90 +++ b/base/serial/psb_cspspmm.f90 @@ -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 + diff --git a/base/serial/psb_dspspmm.f90 b/base/serial/psb_dspspmm.f90 index f0fff17c..cec9699a 100644 --- a/base/serial/psb_dspspmm.f90 +++ b/base/serial/psb_dspspmm.f90 @@ -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 + diff --git a/base/serial/psb_sspspmm.f90 b/base/serial/psb_sspspmm.f90 index 6e521a4c..008bcce6 100644 --- a/base/serial/psb_sspspmm.f90 +++ b/base/serial/psb_sspspmm.f90 @@ -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 + diff --git a/base/serial/psb_zspspmm.f90 b/base/serial/psb_zspspmm.f90 index 13a7be87..a1436ad1 100644 --- a/base/serial/psb_zspspmm.f90 +++ b/base/serial/psb_zspspmm.f90 @@ -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 +