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

Silence more warnings/errors from INTEL

Browse Source
randomized
sfilippone 1 year ago
parent 52212aa24a
commit e282fb1a2a
20 changed files with 172 additions and 164 deletions
Show Stats Download Patch File Download Diff File

15
base/serial/psb_cnumbmm.f90
Unescape Escape View File

@ -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

32
base/serial/psb_crwextd.f90
Unescape Escape View File

@ -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)

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

@ -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

14
base/serial/psb_csymbmm.f90
Unescape Escape View File

@ -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

15
base/serial/psb_dnumbmm.f90
Unescape Escape View File

@ -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

32
base/serial/psb_drwextd.f90
Unescape Escape View File

@ -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)

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

@ -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

14
base/serial/psb_dsymbmm.f90
Unescape Escape View File

@ -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

15
base/serial/psb_snumbmm.f90
Unescape Escape View File

@ -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

32
base/serial/psb_srwextd.f90
Unescape Escape View File

@ -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)

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

@ -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

14
base/serial/psb_ssymbmm.f90
Unescape Escape View File

@ -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

15
base/serial/psb_znumbmm.f90
Unescape Escape View File

@ -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

32
base/serial/psb_zrwextd.f90
Unescape Escape View File

@ -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)

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

@ -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

14
base/serial/psb_zsymbmm.f90
Unescape Escape View File

@ -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

16
base/tools/psb_c_par_csr_spspmm.f90
Unescape Escape View File

@ -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

16
base/tools/psb_d_par_csr_spspmm.f90
Unescape Escape View File

@ -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

16
base/tools/psb_s_par_csr_spspmm.f90
Unescape Escape View File

@ -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

16
base/tools/psb_z_par_csr_spspmm.f90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save