From e282fb1a2ab2de9fd47ccb28f27cfef1d5084e3b Mon Sep 17 00:00:00 2001 From: sfilippone Date: Sat, 1 Mar 2025 12:44:32 +0100 Subject: [PATCH] Silence more warnings/errors from INTEL --- base/serial/psb_cnumbmm.f90 | 15 +++++++------- base/serial/psb_crwextd.f90 | 32 ++++++++++++++--------------- base/serial/psb_cspspmm.f90 | 7 ++++--- base/serial/psb_csymbmm.f90 | 14 ++++++------- base/serial/psb_dnumbmm.f90 | 15 +++++++------- base/serial/psb_drwextd.f90 | 32 ++++++++++++++--------------- base/serial/psb_dspspmm.f90 | 7 ++++--- base/serial/psb_dsymbmm.f90 | 14 ++++++------- base/serial/psb_snumbmm.f90 | 15 +++++++------- base/serial/psb_srwextd.f90 | 32 ++++++++++++++--------------- base/serial/psb_sspspmm.f90 | 7 ++++--- base/serial/psb_ssymbmm.f90 | 14 ++++++------- base/serial/psb_znumbmm.f90 | 15 +++++++------- base/serial/psb_zrwextd.f90 | 32 ++++++++++++++--------------- base/serial/psb_zspspmm.f90 | 7 ++++--- base/serial/psb_zsymbmm.f90 | 14 ++++++------- base/tools/psb_c_par_csr_spspmm.f90 | 16 +++++++++------ base/tools/psb_d_par_csr_spspmm.f90 | 16 +++++++++------ base/tools/psb_s_par_csr_spspmm.f90 | 16 +++++++++------ base/tools/psb_z_par_csr_spspmm.f90 | 16 +++++++++------ 20 files changed, 172 insertions(+), 164 deletions(-) diff --git a/base/serial/psb_cnumbmm.f90 b/base/serial/psb_cnumbmm.f90 index c965d4f3..920187b3 100644 --- a/base/serial/psb_cnumbmm.f90 +++ b/base/serial/psb_cnumbmm.f90 @@ -40,7 +40,8 @@ ! ! subroutine psb_cnumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_cnumbmm + use psb_mat_mod + use psb_c_serial_mod, only : psb_cbase_numbmm implicit none type(psb_cspmat_type), intent(in) :: a,b @@ -60,7 +61,7 @@ subroutine psb_cnumbmm(a,b,c) select type(aa=>c%a) type is (psb_c_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_cbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -81,7 +82,6 @@ end subroutine psb_cnumbmm subroutine psb_cbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_cbase_numbmm implicit none class(psb_c_base_sparse_mat), intent(in) :: a,b @@ -234,10 +234,10 @@ contains end subroutine psb_cbase_numbmm - - subroutine psb_lcnumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_lcnumbmm + use psb_mat_mod + use psb_c_serial_mod, only : psb_lcbase_numbmm + implicit none type(psb_lcspmat_type), intent(in) :: a,b @@ -257,7 +257,7 @@ subroutine psb_lcnumbmm(a,b,c) select type(aa=>c%a) type is (psb_lc_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_lcbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -278,7 +278,6 @@ end subroutine psb_lcnumbmm subroutine psb_lcbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_lcbase_numbmm implicit none class(psb_lc_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_crwextd.f90 b/base/serial/psb_crwextd.f90 index 1b55e4db..9676ad24 100644 --- a/base/serial/psb_crwextd.f90 +++ b/base/serial/psb_crwextd.f90 @@ -40,7 +40,7 @@ ! subroutine psb_crwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_crwextd + use psb_c_serial_mod, only : psb_cbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -63,23 +63,23 @@ subroutine psb_crwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_c_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_cbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_cbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_c_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_cbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_cbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_cbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_cbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -95,9 +95,9 @@ subroutine psb_crwextd(nr,a,info,b,rowscale) return end subroutine psb_crwextd + subroutine psb_cbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_cbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -240,7 +240,7 @@ end subroutine psb_cbase_rwextd subroutine psb_lcrwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lcrwextd + use psb_c_serial_mod, only : psb_lcbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -264,23 +264,23 @@ subroutine psb_lcrwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_lc_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_lcbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_lcbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_lc_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_lcbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_lcbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_lcbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_lcbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -296,9 +296,9 @@ subroutine psb_lcrwextd(nr,a,info,b,rowscale) return end subroutine psb_lcrwextd + subroutine psb_lcbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lcbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) diff --git a/base/serial/psb_cspspmm.f90 b/base/serial/psb_cspspmm.f90 index ef56757e..72a50fbc 100644 --- a/base/serial/psb_cspspmm.f90 +++ b/base/serial/psb_cspspmm.f90 @@ -36,7 +36,8 @@ ! ! subroutine psb_cspspmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_cspspmm + use psb_mat_mod + use psb_c_serial_mod, only : psb_ccscspspmm, psb_ccsrspspmm implicit none type(psb_cspmat_type), intent(in) :: a,b @@ -115,9 +116,9 @@ 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 + use psb_mat_mod + use psb_c_serial_mod, only : psb_lccscspspmm, psb_lccsrspspmm implicit none type(psb_lcspmat_type), intent(in) :: a,b diff --git a/base/serial/psb_csymbmm.f90 b/base/serial/psb_csymbmm.f90 index 25818791..24e7dda8 100644 --- a/base/serial/psb_csymbmm.f90 +++ b/base/serial/psb_csymbmm.f90 @@ -40,7 +40,8 @@ ! subroutine psb_csymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_csymbmm + use psb_mat_mod + use psb_c_serial_mod, only : psb_cbase_symbmm implicit none type(psb_cspmat_type), intent(in) :: a,b @@ -61,7 +62,7 @@ subroutine psb_csymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_cbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -83,7 +84,6 @@ end subroutine psb_csymbmm subroutine psb_cbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_cbase_symbmm implicit none class(psb_c_base_sparse_mat), intent(in) :: a,b @@ -256,10 +256,9 @@ contains end subroutine psb_cbase_symbmm - - subroutine psb_lcsymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_lcsymbmm + use psb_mat_mod + use psb_c_serial_mod, only : psb_lcbase_symbmm implicit none type(psb_lcspmat_type), intent(in) :: a,b @@ -280,7 +279,7 @@ subroutine psb_lcsymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_lcbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -302,7 +301,6 @@ end subroutine psb_lcsymbmm subroutine psb_lcbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lcbase_symbmm implicit none class(psb_lc_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_dnumbmm.f90 b/base/serial/psb_dnumbmm.f90 index c1d3951c..4719b2bc 100644 --- a/base/serial/psb_dnumbmm.f90 +++ b/base/serial/psb_dnumbmm.f90 @@ -40,7 +40,8 @@ ! ! subroutine psb_dnumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_dnumbmm + use psb_mat_mod + use psb_d_serial_mod, only : psb_dbase_numbmm implicit none type(psb_dspmat_type), intent(in) :: a,b @@ -60,7 +61,7 @@ subroutine psb_dnumbmm(a,b,c) select type(aa=>c%a) type is (psb_d_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_dbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -81,7 +82,6 @@ end subroutine psb_dnumbmm subroutine psb_dbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_dbase_numbmm implicit none class(psb_d_base_sparse_mat), intent(in) :: a,b @@ -234,10 +234,10 @@ contains end subroutine psb_dbase_numbmm - - subroutine psb_ldnumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_ldnumbmm + use psb_mat_mod + use psb_d_serial_mod, only : psb_ldbase_numbmm + implicit none type(psb_ldspmat_type), intent(in) :: a,b @@ -257,7 +257,7 @@ subroutine psb_ldnumbmm(a,b,c) select type(aa=>c%a) type is (psb_ld_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_ldbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -278,7 +278,6 @@ end subroutine psb_ldnumbmm subroutine psb_ldbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_ldbase_numbmm implicit none class(psb_ld_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_drwextd.f90 b/base/serial/psb_drwextd.f90 index 9abc42d2..70c73f83 100644 --- a/base/serial/psb_drwextd.f90 +++ b/base/serial/psb_drwextd.f90 @@ -40,7 +40,7 @@ ! subroutine psb_drwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_drwextd + use psb_d_serial_mod, only : psb_dbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -63,23 +63,23 @@ subroutine psb_drwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_d_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_dbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_dbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_d_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_dbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_dbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_dbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_dbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -95,9 +95,9 @@ subroutine psb_drwextd(nr,a,info,b,rowscale) return end subroutine psb_drwextd + subroutine psb_dbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_dbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -240,7 +240,7 @@ end subroutine psb_dbase_rwextd subroutine psb_ldrwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_ldrwextd + use psb_d_serial_mod, only : psb_ldbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -264,23 +264,23 @@ subroutine psb_ldrwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_ld_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_ldbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_ldbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_ld_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_ldbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_ldbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_ldbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_ldbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -296,9 +296,9 @@ subroutine psb_ldrwextd(nr,a,info,b,rowscale) return end subroutine psb_ldrwextd + subroutine psb_ldbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_ldbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) diff --git a/base/serial/psb_dspspmm.f90 b/base/serial/psb_dspspmm.f90 index cec9699a..c8e6cd66 100644 --- a/base/serial/psb_dspspmm.f90 +++ b/base/serial/psb_dspspmm.f90 @@ -36,7 +36,8 @@ ! ! subroutine psb_dspspmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_dspspmm + use psb_mat_mod + use psb_d_serial_mod, only : psb_dcscspspmm, psb_dcsrspspmm implicit none type(psb_dspmat_type), intent(in) :: a,b @@ -115,9 +116,9 @@ 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 + use psb_mat_mod + use psb_d_serial_mod, only : psb_ldcscspspmm, psb_ldcsrspspmm implicit none type(psb_ldspmat_type), intent(in) :: a,b diff --git a/base/serial/psb_dsymbmm.f90 b/base/serial/psb_dsymbmm.f90 index 3dcad00f..fa6703eb 100644 --- a/base/serial/psb_dsymbmm.f90 +++ b/base/serial/psb_dsymbmm.f90 @@ -40,7 +40,8 @@ ! subroutine psb_dsymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_dsymbmm + use psb_mat_mod + use psb_d_serial_mod, only : psb_dbase_symbmm implicit none type(psb_dspmat_type), intent(in) :: a,b @@ -61,7 +62,7 @@ subroutine psb_dsymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_dbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -83,7 +84,6 @@ end subroutine psb_dsymbmm subroutine psb_dbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_dbase_symbmm implicit none class(psb_d_base_sparse_mat), intent(in) :: a,b @@ -256,10 +256,9 @@ contains end subroutine psb_dbase_symbmm - - subroutine psb_ldsymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_ldsymbmm + use psb_mat_mod + use psb_d_serial_mod, only : psb_ldbase_symbmm implicit none type(psb_ldspmat_type), intent(in) :: a,b @@ -280,7 +279,7 @@ subroutine psb_ldsymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_ldbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -302,7 +301,6 @@ end subroutine psb_ldsymbmm subroutine psb_ldbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_ldbase_symbmm implicit none class(psb_ld_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_snumbmm.f90 b/base/serial/psb_snumbmm.f90 index ceffb977..99075a8b 100644 --- a/base/serial/psb_snumbmm.f90 +++ b/base/serial/psb_snumbmm.f90 @@ -40,7 +40,8 @@ ! ! subroutine psb_snumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_snumbmm + use psb_mat_mod + use psb_s_serial_mod, only : psb_sbase_numbmm implicit none type(psb_sspmat_type), intent(in) :: a,b @@ -60,7 +61,7 @@ subroutine psb_snumbmm(a,b,c) select type(aa=>c%a) type is (psb_s_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_sbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -81,7 +82,6 @@ end subroutine psb_snumbmm subroutine psb_sbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_sbase_numbmm implicit none class(psb_s_base_sparse_mat), intent(in) :: a,b @@ -234,10 +234,10 @@ contains end subroutine psb_sbase_numbmm - - subroutine psb_lsnumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_lsnumbmm + use psb_mat_mod + use psb_s_serial_mod, only : psb_lsbase_numbmm + implicit none type(psb_lsspmat_type), intent(in) :: a,b @@ -257,7 +257,7 @@ subroutine psb_lsnumbmm(a,b,c) select type(aa=>c%a) type is (psb_ls_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_lsbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -278,7 +278,6 @@ end subroutine psb_lsnumbmm subroutine psb_lsbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_lsbase_numbmm implicit none class(psb_ls_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_srwextd.f90 b/base/serial/psb_srwextd.f90 index eb7ecf00..3ecd7a8e 100644 --- a/base/serial/psb_srwextd.f90 +++ b/base/serial/psb_srwextd.f90 @@ -40,7 +40,7 @@ ! subroutine psb_srwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_srwextd + use psb_s_serial_mod, only : psb_sbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -63,23 +63,23 @@ subroutine psb_srwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_s_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_sbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_sbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_s_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_sbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_sbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_sbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_sbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -95,9 +95,9 @@ subroutine psb_srwextd(nr,a,info,b,rowscale) return end subroutine psb_srwextd + subroutine psb_sbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_sbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -240,7 +240,7 @@ end subroutine psb_sbase_rwextd subroutine psb_lsrwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lsrwextd + use psb_s_serial_mod, only : psb_lsbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -264,23 +264,23 @@ subroutine psb_lsrwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_ls_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_lsbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_lsbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_ls_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_lsbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_lsbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_lsbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_lsbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -296,9 +296,9 @@ subroutine psb_lsrwextd(nr,a,info,b,rowscale) return end subroutine psb_lsrwextd + subroutine psb_lsbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lsbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) diff --git a/base/serial/psb_sspspmm.f90 b/base/serial/psb_sspspmm.f90 index 008bcce6..82ee7836 100644 --- a/base/serial/psb_sspspmm.f90 +++ b/base/serial/psb_sspspmm.f90 @@ -36,7 +36,8 @@ ! ! subroutine psb_sspspmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_sspspmm + use psb_mat_mod + use psb_s_serial_mod, only : psb_scscspspmm, psb_scsrspspmm implicit none type(psb_sspmat_type), intent(in) :: a,b @@ -115,9 +116,9 @@ 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 + use psb_mat_mod + use psb_s_serial_mod, only : psb_lscscspspmm, psb_lscsrspspmm implicit none type(psb_lsspmat_type), intent(in) :: a,b diff --git a/base/serial/psb_ssymbmm.f90 b/base/serial/psb_ssymbmm.f90 index 729dd856..22589899 100644 --- a/base/serial/psb_ssymbmm.f90 +++ b/base/serial/psb_ssymbmm.f90 @@ -40,7 +40,8 @@ ! subroutine psb_ssymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_ssymbmm + use psb_mat_mod + use psb_s_serial_mod, only : psb_sbase_symbmm implicit none type(psb_sspmat_type), intent(in) :: a,b @@ -61,7 +62,7 @@ subroutine psb_ssymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_sbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -83,7 +84,6 @@ end subroutine psb_ssymbmm subroutine psb_sbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_sbase_symbmm implicit none class(psb_s_base_sparse_mat), intent(in) :: a,b @@ -256,10 +256,9 @@ contains end subroutine psb_sbase_symbmm - - subroutine psb_lssymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_lssymbmm + use psb_mat_mod + use psb_s_serial_mod, only : psb_lsbase_symbmm implicit none type(psb_lsspmat_type), intent(in) :: a,b @@ -280,7 +279,7 @@ subroutine psb_lssymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_lsbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -302,7 +301,6 @@ end subroutine psb_lssymbmm subroutine psb_lsbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lsbase_symbmm implicit none class(psb_ls_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_znumbmm.f90 b/base/serial/psb_znumbmm.f90 index be4e1026..31b8f6b2 100644 --- a/base/serial/psb_znumbmm.f90 +++ b/base/serial/psb_znumbmm.f90 @@ -40,7 +40,8 @@ ! ! subroutine psb_znumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_znumbmm + use psb_mat_mod + use psb_z_serial_mod, only : psb_zbase_numbmm implicit none type(psb_zspmat_type), intent(in) :: a,b @@ -60,7 +61,7 @@ subroutine psb_znumbmm(a,b,c) select type(aa=>c%a) type is (psb_z_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_zbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -81,7 +82,6 @@ end subroutine psb_znumbmm subroutine psb_zbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_zbase_numbmm implicit none class(psb_z_base_sparse_mat), intent(in) :: a,b @@ -234,10 +234,10 @@ contains end subroutine psb_zbase_numbmm - - subroutine psb_lznumbmm(a,b,c) - use psb_base_mod, psb_protect_name => psb_lznumbmm + use psb_mat_mod + use psb_z_serial_mod, only : psb_lzbase_numbmm + implicit none type(psb_lzspmat_type), intent(in) :: a,b @@ -257,7 +257,7 @@ subroutine psb_lznumbmm(a,b,c) select type(aa=>c%a) type is (psb_lz_csr_sparse_mat) - call psb_numbmm(a%a,b%a,aa) + call psb_lzbase_numbmm(a%a,b%a,aa) class default info = psb_err_invalid_mat_state_ call psb_errpush(info,name) @@ -278,7 +278,6 @@ end subroutine psb_lznumbmm subroutine psb_lzbase_numbmm(a,b,c) use psb_mat_mod use psb_string_mod - use psb_serial_mod, psb_protect_name => psb_lzbase_numbmm implicit none class(psb_lz_base_sparse_mat), intent(in) :: a,b diff --git a/base/serial/psb_zrwextd.f90 b/base/serial/psb_zrwextd.f90 index f3e07f26..393a3d9d 100644 --- a/base/serial/psb_zrwextd.f90 +++ b/base/serial/psb_zrwextd.f90 @@ -40,7 +40,7 @@ ! subroutine psb_zrwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_zrwextd + use psb_z_serial_mod, only : psb_zbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -63,23 +63,23 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_z_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_zbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_zbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_z_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_zbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_zbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_zbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_zbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -95,9 +95,9 @@ subroutine psb_zrwextd(nr,a,info,b,rowscale) return end subroutine psb_zrwextd + subroutine psb_zbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_zbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -240,7 +240,7 @@ end subroutine psb_zbase_rwextd subroutine psb_lzrwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lzrwextd + use psb_z_serial_mod, only : psb_lzbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) @@ -264,23 +264,23 @@ subroutine psb_lzrwextd(nr,a,info,b,rowscale) select type(aa=> a%a) type is (psb_lz_csr_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale) + call psb_lzbase_rwextd(nr,aa,info,b%a,rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_lzbase_rwextd(nr,aa,info,rowscale=rowscale) end if type is (psb_lz_coo_sparse_mat) if (present(b)) then - call psb_rwextd(nr,aa,info,b%a,rowscale=rowscale) + call psb_lzbase_rwextd(nr,aa,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,aa,info,rowscale=rowscale) + call psb_lzbase_rwextd(nr,aa,info,rowscale=rowscale) end if class default call aa%mv_to_coo(actmp,info) if (info == psb_success_) then if (present(b)) then - call psb_rwextd(nr,actmp,info,b%a,rowscale=rowscale) + call psb_lzbase_rwextd(nr,actmp,info,b%a,rowscale=rowscale) else - call psb_rwextd(nr,actmp,info,rowscale=rowscale) + call psb_lzbase_rwextd(nr,actmp,info,rowscale=rowscale) end if end if if (info == psb_success_) call aa%mv_from_coo(actmp,info) @@ -296,9 +296,9 @@ subroutine psb_lzrwextd(nr,a,info,b,rowscale) return end subroutine psb_lzrwextd + subroutine psb_lzbase_rwextd(nr,a,info,b,rowscale) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lzbase_rwextd implicit none ! Extend matrix A up to NR rows with empty ones (i.e.: all zeroes) diff --git a/base/serial/psb_zspspmm.f90 b/base/serial/psb_zspspmm.f90 index a1436ad1..cbf273e2 100644 --- a/base/serial/psb_zspspmm.f90 +++ b/base/serial/psb_zspspmm.f90 @@ -36,7 +36,8 @@ ! ! subroutine psb_zspspmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_zspspmm + use psb_mat_mod + use psb_z_serial_mod, only : psb_zcscspspmm, psb_zcsrspspmm implicit none type(psb_zspmat_type), intent(in) :: a,b @@ -115,9 +116,9 @@ 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 + use psb_mat_mod + use psb_z_serial_mod, only : psb_lzcscspspmm, psb_lzcsrspspmm implicit none type(psb_lzspmat_type), intent(in) :: a,b diff --git a/base/serial/psb_zsymbmm.f90 b/base/serial/psb_zsymbmm.f90 index ada82326..24e9567c 100644 --- a/base/serial/psb_zsymbmm.f90 +++ b/base/serial/psb_zsymbmm.f90 @@ -40,7 +40,8 @@ ! subroutine psb_zsymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_zsymbmm + use psb_mat_mod + use psb_z_serial_mod, only : psb_zbase_symbmm implicit none type(psb_zspmat_type), intent(in) :: a,b @@ -61,7 +62,7 @@ subroutine psb_zsymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_zbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -83,7 +84,6 @@ end subroutine psb_zsymbmm subroutine psb_zbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_zbase_symbmm implicit none class(psb_z_base_sparse_mat), intent(in) :: a,b @@ -256,10 +256,9 @@ contains end subroutine psb_zbase_symbmm - - subroutine psb_lzsymbmm(a,b,c,info) - use psb_base_mod, psb_protect_name => psb_lzsymbmm + use psb_mat_mod + use psb_z_serial_mod, only : psb_lzbase_symbmm implicit none type(psb_lzspmat_type), intent(in) :: a,b @@ -280,7 +279,7 @@ subroutine psb_lzsymbmm(a,b,c,info) allocate(ccsr,stat=info) if (info == psb_success_) then - call psb_symbmm(a%a,b%a,ccsr,info) + call psb_lzbase_symbmm(a%a,b%a,ccsr,info) else info = psb_err_alloc_dealloc_ end if @@ -302,7 +301,6 @@ end subroutine psb_lzsymbmm subroutine psb_lzbase_symbmm(a,b,c,info) use psb_mat_mod - use psb_serial_mod, psb_protect_name => psb_lzbase_symbmm implicit none class(psb_lz_base_sparse_mat), intent(in) :: a,b diff --git a/base/tools/psb_c_par_csr_spspmm.f90 b/base/tools/psb_c_par_csr_spspmm.f90 index d5684b11..7a802fa8 100644 --- a/base/tools/psb_c_par_csr_spspmm.f90 +++ b/base/tools/psb_c_par_csr_spspmm.f90 @@ -62,7 +62,9 @@ ! Error code. ! Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_c_par_csr_spspmm + use psb_mat_mod + use psb_c_tools_mod, psb_protect_name => psb_c_par_csr_spspmm + use psb_c_serial_mod, only : psb_ccsrspspmm, psb_cbase_rwextd Implicit None type(psb_c_csr_sparse_mat),intent(in) :: acsr @@ -132,7 +134,7 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) end if call ltcsr%mv_to_ifmt(tcsr,info) - if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call psb_cbase_rwextd(ncol,bcsr,info,b=tcsr) if (info == psb_success_) call tcsr%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -146,7 +148,7 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_ccsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return @@ -158,7 +160,9 @@ Subroutine psb_c_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) End Subroutine psb_c_par_csr_spspmm Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_lc_par_csr_spspmm + use psb_mat_mod + use psb_c_tools_mod, psb_protect_name => psb_lc_par_csr_spspmm + use psb_c_serial_mod, only : psb_lccsrspspmm, psb_lcbase_rwextd Implicit None type(psb_lc_csr_sparse_mat),intent(in) :: acsr @@ -226,7 +230,7 @@ Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) else call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) end if - if (info == psb_success_) call psb_rwextd(nacol,bcsr,info,b=tcsr1) + if (info == psb_success_) call psb_lcbase_rwextd(nacol,bcsr,info,b=tcsr1) if (info == psb_success_) call tcsr1%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -241,7 +245,7 @@ Subroutine psb_lc_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_lccsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_d_par_csr_spspmm.f90 b/base/tools/psb_d_par_csr_spspmm.f90 index f9d110f7..0dcbaebe 100644 --- a/base/tools/psb_d_par_csr_spspmm.f90 +++ b/base/tools/psb_d_par_csr_spspmm.f90 @@ -62,7 +62,9 @@ ! Error code. ! Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_d_par_csr_spspmm + use psb_mat_mod + use psb_d_tools_mod, psb_protect_name => psb_d_par_csr_spspmm + use psb_d_serial_mod, only : psb_dcsrspspmm, psb_dbase_rwextd Implicit None type(psb_d_csr_sparse_mat),intent(in) :: acsr @@ -132,7 +134,7 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) end if call ltcsr%mv_to_ifmt(tcsr,info) - if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call psb_dbase_rwextd(ncol,bcsr,info,b=tcsr) if (info == psb_success_) call tcsr%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -146,7 +148,7 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_dcsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return @@ -158,7 +160,9 @@ Subroutine psb_d_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) End Subroutine psb_d_par_csr_spspmm Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_ld_par_csr_spspmm + use psb_mat_mod + use psb_d_tools_mod, psb_protect_name => psb_ld_par_csr_spspmm + use psb_d_serial_mod, only : psb_ldcsrspspmm, psb_ldbase_rwextd Implicit None type(psb_ld_csr_sparse_mat),intent(in) :: acsr @@ -226,7 +230,7 @@ Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) else call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) end if - if (info == psb_success_) call psb_rwextd(nacol,bcsr,info,b=tcsr1) + if (info == psb_success_) call psb_ldbase_rwextd(nacol,bcsr,info,b=tcsr1) if (info == psb_success_) call tcsr1%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -241,7 +245,7 @@ Subroutine psb_ld_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_ldcsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_s_par_csr_spspmm.f90 b/base/tools/psb_s_par_csr_spspmm.f90 index 549aeba4..149a5612 100644 --- a/base/tools/psb_s_par_csr_spspmm.f90 +++ b/base/tools/psb_s_par_csr_spspmm.f90 @@ -62,7 +62,9 @@ ! Error code. ! Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_s_par_csr_spspmm + use psb_mat_mod + use psb_s_tools_mod, psb_protect_name => psb_s_par_csr_spspmm + use psb_s_serial_mod, only : psb_scsrspspmm, psb_sbase_rwextd Implicit None type(psb_s_csr_sparse_mat),intent(in) :: acsr @@ -132,7 +134,7 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) end if call ltcsr%mv_to_ifmt(tcsr,info) - if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call psb_sbase_rwextd(ncol,bcsr,info,b=tcsr) if (info == psb_success_) call tcsr%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -146,7 +148,7 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_scsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return @@ -158,7 +160,9 @@ Subroutine psb_s_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) End Subroutine psb_s_par_csr_spspmm Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_ls_par_csr_spspmm + use psb_mat_mod + use psb_s_tools_mod, psb_protect_name => psb_ls_par_csr_spspmm + use psb_s_serial_mod, only : psb_lscsrspspmm, psb_lsbase_rwextd Implicit None type(psb_ls_csr_sparse_mat),intent(in) :: acsr @@ -226,7 +230,7 @@ Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) else call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) end if - if (info == psb_success_) call psb_rwextd(nacol,bcsr,info,b=tcsr1) + if (info == psb_success_) call psb_lsbase_rwextd(nacol,bcsr,info,b=tcsr1) if (info == psb_success_) call tcsr1%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -241,7 +245,7 @@ Subroutine psb_ls_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_lscsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return diff --git a/base/tools/psb_z_par_csr_spspmm.f90 b/base/tools/psb_z_par_csr_spspmm.f90 index 4b88ffab..073927fa 100644 --- a/base/tools/psb_z_par_csr_spspmm.f90 +++ b/base/tools/psb_z_par_csr_spspmm.f90 @@ -62,7 +62,9 @@ ! Error code. ! Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_z_par_csr_spspmm + use psb_mat_mod + use psb_z_tools_mod, psb_protect_name => psb_z_par_csr_spspmm + use psb_z_serial_mod, only : psb_zcsrspspmm, psb_zbase_rwextd Implicit None type(psb_z_csr_sparse_mat),intent(in) :: acsr @@ -132,7 +134,7 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) call desc_c%indxmap%g2lip(ltcsr%ja(1:nnz),info) end if call ltcsr%mv_to_ifmt(tcsr,info) - if (info == psb_success_) call psb_rwextd(ncol,bcsr,info,b=tcsr) + if (info == psb_success_) call psb_zbase_rwextd(ncol,bcsr,info,b=tcsr) if (info == psb_success_) call tcsr%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -146,7 +148,7 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_zcsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return @@ -158,7 +160,9 @@ Subroutine psb_z_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) End Subroutine psb_z_par_csr_spspmm Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) - use psb_base_mod, psb_protect_name => psb_lz_par_csr_spspmm + use psb_mat_mod + use psb_z_tools_mod, psb_protect_name => psb_lz_par_csr_spspmm + use psb_z_serial_mod, only : psb_lzcsrspspmm, psb_lzbase_rwextd Implicit None type(psb_lz_csr_sparse_mat),intent(in) :: acsr @@ -226,7 +230,7 @@ Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) else call desc_c%indxmap%g2lip(tcsr1%ja(1:nnz),info) end if - if (info == psb_success_) call psb_rwextd(nacol,bcsr,info,b=tcsr1) + if (info == psb_success_) call psb_lzbase_rwextd(nacol,bcsr,info,b=tcsr1) if (info == psb_success_) call tcsr1%free() if(info /= psb_success_) then call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') @@ -241,7 +245,7 @@ Subroutine psb_lz_par_csr_spspmm(acsr,desc_a,bcsr,ccsr,desc_c,info,data) & 'starting spspmm 3' if (debug_level >= psb_debug_outer_) write(debug_unit,*) me,' ',trim(name),& & 'starting spspmm ',acsr%get_nrows(),acsr%get_ncols(),bcsr%get_nrows(),bcsr%get_ncols() - call psb_spspmm(acsr,bcsr,ccsr,info) + call psb_lzcsrspspmm(acsr,bcsr,ccsr,info) call psb_erractionrestore(err_act) return