@ -109,6 +109,7 @@ module psb_s_mat_mod
procedure , pass ( a ) :: s_cscnv_ip = > psb_s_cscnv_ip
procedure , pass ( a ) :: s_cscnv_ip = > psb_s_cscnv_ip
procedure , pass ( a ) :: s_cscnv_base = > psb_s_cscnv_base
procedure , pass ( a ) :: s_cscnv_base = > psb_s_cscnv_base
generic , public :: cscnv = > s_cscnv , s_cscnv_ip , s_cscnv_base
generic , public :: cscnv = > s_cscnv , s_cscnv_ip , s_cscnv_base
procedure , pass ( a ) :: clone = > psb_sspmat_type_clone
procedure , pass ( a ) :: reinit = > psb_s_reinit
procedure , pass ( a ) :: reinit = > psb_s_reinit
procedure , pass ( a ) :: print_i = > psb_s_sparse_print
procedure , pass ( a ) :: print_i = > psb_s_sparse_print
procedure , pass ( a ) :: print_n = > psb_s_n_sparse_print
procedure , pass ( a ) :: print_n = > psb_s_n_sparse_print
@ -129,6 +130,8 @@ module psb_s_mat_mod
procedure , pass ( a ) :: s_transc_2mat = > psb_s_transc_2mat
procedure , pass ( a ) :: s_transc_2mat = > psb_s_transc_2mat
generic , public :: transc = > s_transc_1mat , s_transc_2mat
generic , public :: transc = > s_transc_1mat , s_transc_2mat
! Computational routines
! Computational routines
procedure , pass ( a ) :: get_diag = > psb_s_get_diag
procedure , pass ( a ) :: get_diag = > psb_s_get_diag
procedure , pass ( a ) :: maxval = > psb_s_maxval
procedure , pass ( a ) :: maxval = > psb_s_maxval
@ -153,9 +156,9 @@ module psb_s_mat_mod
end type psb_sspmat_type
end type psb_sspmat_type
private :: psb_s_get_nrows , psb_s_get_ncols , psb_s_get_nzeros , psb_s_get_size , &
private :: psb_s_get_nrows , psb_s_get_ncols , psb_s_get_nzeros , psb_s_get_size , &
& psb_s_get_state , psb_s_get_dupl , psb_s_is_null , psb_s_is_bld , &
& psb_s_get_state , psb_s_get_dupl , psb_s_is_null , psb_s_is_bld , psb_s_is_upd , &
& psb_s_is_ upd, psb_s_is_ asb, psb_s_is_sorted , psb_s_is_upper , &
& psb_s_is_ asb, psb_s_is_sorted , psb_s_is_upper , psb_s_is_lower , psb_s_is_triangle , &
& psb_s_ is_lower, psb_s_is_triangle , psb_s_ get_nz_row
& psb_s_ get_nz_row
interface psb_sizeof
interface psb_sizeof
module procedure psb_s_sizeof
module procedure psb_s_sizeof
@ -276,6 +279,7 @@ module psb_s_mat_mod
end subroutine psb_s_set_upper
end subroutine psb_s_set_upper
end interface
end interface
interface
interface
subroutine psb_s_sparse_print ( iout , a , iv , eirs , eics , head , ivr , ivc )
subroutine psb_s_sparse_print ( iout , a , iv , eirs , eics , head , ivr , ivc )
import :: psb_sspmat_type
import :: psb_sspmat_type
@ -346,9 +350,9 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_csput ( nz , ia , ja , val , a , imin , imax , jmin , jmax , info , gtl )
subroutine psb_s_csput ( nz , ia , ja , val , a , imin , imax , jmin , jmax , info , gtl )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( inout ) :: a
class ( psb_sspmat_type ) , intent ( inout ) :: a
real ( psb_ d pk_) , intent ( in ) :: val ( : )
real ( psb_ s pk_) , intent ( in ) :: val ( : )
integer , intent ( in ) :: nz , ia ( : ) , ja ( : ) , imin , imax , jmin , jmax
integer , intent ( in ) :: nz , ia ( : ) , ja ( : ) , imin , imax , jmin , jmax
integer , intent ( out ) :: info
integer , intent ( out ) :: info
integer , intent ( in ) , optional :: gtl ( : )
integer , intent ( in ) , optional :: gtl ( : )
@ -357,8 +361,8 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_csgetptn ( imin , imax , a , nz , ia , ja , info , &
subroutine psb_s_csgetptn ( imin , imax , a , nz , ia , ja , info , &
& jmin , jmax , iren , append , nzin , rscale , cscale )
& jmin , jmax , iren , append , nzin , rscale , cscale )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
integer , intent ( in ) :: imin , imax
integer , intent ( in ) :: imin , imax
integer , intent ( out ) :: nz
integer , intent ( out ) :: nz
@ -374,12 +378,12 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_csgetrow ( imin , imax , a , nz , ia , ja , val , info , &
subroutine psb_s_csgetrow ( imin , imax , a , nz , ia , ja , val , info , &
& jmin , jmax , iren , append , nzin , rscale , cscale )
& jmin , jmax , iren , append , nzin , rscale , cscale )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
integer , intent ( in ) :: imin , imax
integer , intent ( in ) :: imin , imax
integer , intent ( out ) :: nz
integer , intent ( out ) :: nz
integer , allocatable , intent ( inout ) :: ia ( : ) , ja ( : )
integer , allocatable , intent ( inout ) :: ia ( : ) , ja ( : )
real ( psb_ d pk_) , allocatable , intent ( inout ) :: val ( : )
real ( psb_ s pk_) , allocatable , intent ( inout ) :: val ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
logical , intent ( in ) , optional :: append
logical , intent ( in ) , optional :: append
integer , intent ( in ) , optional :: iren ( : )
integer , intent ( in ) , optional :: iren ( : )
@ -390,8 +394,8 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_csgetblk ( imin , imax , a , b , info , &
subroutine psb_s_csgetblk ( imin , imax , a , b , info , &
& jmin , jmax , iren , append , rscale , cscale )
& jmin , jmax , iren , append , rscale , cscale )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( out ) :: b
class ( psb_sspmat_type ) , intent ( out ) :: b
integer , intent ( in ) :: imin , imax
integer , intent ( in ) :: imin , imax
@ -405,8 +409,8 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_csclip ( a , b , info , &
subroutine psb_s_csclip ( a , b , info , &
& imin , imax , jmin , jmax , rscale , cscale )
& imin , imax , jmin , jmax , rscale , cscale )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( out ) :: b
class ( psb_sspmat_type ) , intent ( out ) :: b
integer , intent ( out ) :: info
integer , intent ( out ) :: info
@ -417,8 +421,8 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_b_csclip ( a , b , info , &
subroutine psb_s_b_csclip ( a , b , info , &
& imin , imax , jmin , jmax , rscale , cscale )
& imin , imax , jmin , jmax , rscale , cscale )
import :: psb_sspmat_type , psb_ d pk_, psb_s_coo_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_coo_sparse_mat
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
type ( psb_s_coo_sparse_mat ) , intent ( out ) :: b
type ( psb_s_coo_sparse_mat ) , intent ( out ) :: b
integer , intent ( out ) :: info
integer , intent ( out ) :: info
@ -429,7 +433,7 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_cscnv ( a , b , info , type , mold , upd , dupl )
subroutine psb_s_cscnv ( a , b , info , type , mold , upd , dupl )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( out ) :: b
class ( psb_sspmat_type ) , intent ( out ) :: b
integer , intent ( out ) :: info
integer , intent ( out ) :: info
@ -442,7 +446,7 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_cscnv_ip ( a , iinfo , type , mold , dupl )
subroutine psb_s_cscnv_ip ( a , iinfo , type , mold , dupl )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( inout ) :: a
class ( psb_sspmat_type ) , intent ( inout ) :: a
integer , intent ( out ) :: iinfo
integer , intent ( out ) :: iinfo
integer , optional , intent ( in ) :: dupl
integer , optional , intent ( in ) :: dupl
@ -454,7 +458,7 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_cscnv_base ( a , b , info , dupl )
subroutine psb_s_cscnv_base ( a , b , info , dupl )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_s_base_sparse_mat ) , intent ( out ) :: b
class ( psb_s_base_sparse_mat ) , intent ( out ) :: b
integer , intent ( out ) :: info
integer , intent ( out ) :: info
@ -481,32 +485,32 @@ module psb_s_mat_mod
interface
interface
subroutine psb_s_mv_from ( a , b )
subroutine psb_s_mv_from ( a , b )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( out ) :: a
class ( psb_sspmat_type ) , intent ( out ) :: a
class ( psb_s_base_sparse_mat ) , intent ( inout ) :: b
class ( psb_s_base_sparse_mat ) , intent ( inout ) :: b
end subroutine psb_s_mv_from
end subroutine psb_s_mv_from
end interface
end interface
interface
interface
subroutine psb_s_cp_from ( a , b )
subroutine psb_s_cp_from ( a , b )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( out ) :: a
class ( psb_sspmat_type ) , intent ( out ) :: a
class ( psb_s_base_sparse_mat ) , intent ( in out ) , allocatable :: b
class ( psb_s_base_sparse_mat ) , intent ( in ) :: b
end subroutine psb_s_cp_from
end subroutine psb_s_cp_from
end interface
end interface
interface
interface
subroutine psb_s_mv_to ( a , b )
subroutine psb_s_mv_to ( a , b )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( inout ) :: a
class ( psb_sspmat_type ) , intent ( inout ) :: a
class ( psb_s_base_sparse_mat ) , intent ( out ) :: b
class ( psb_s_base_sparse_mat ) , intent ( out ) :: b
end subroutine psb_s_mv_to
end subroutine psb_s_mv_to
end interface
end interface
interface
interface
subroutine psb_s_cp_to ( a , b )
subroutine psb_s_cp_to ( a , b )
import :: psb_sspmat_type , psb_ d pk_, psb_s_base_sparse_mat
import :: psb_sspmat_type , psb_ s pk_, psb_s_base_sparse_mat
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_s_base_sparse_mat ) , intent ( out ) :: b
class ( psb_s_base_sparse_mat ) , intent ( out ) :: b
end subroutine psb_s_cp_to
end subroutine psb_s_cp_to
end interface
end interface
@ -518,7 +522,7 @@ module psb_s_mat_mod
class ( psb_sspmat_type ) , intent ( out ) :: b
class ( psb_sspmat_type ) , intent ( out ) :: b
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_sspmat_type_move
end subroutine psb_sspmat_type_move
end interface
end interface psb_move_alloc
interface psb_clone
interface psb_clone
subroutine psb_sspmat_type_clone ( a , b , info )
subroutine psb_sspmat_type_clone ( a , b , info )
@ -577,7 +581,6 @@ module psb_s_mat_mod
end interface
end interface
! == == == == == == == == == == == == == == == == == == =
! == == == == == == == == == == == == == == == == == == =
!
!
!
!
@ -593,26 +596,26 @@ module psb_s_mat_mod
interface psb_csmm
interface psb_csmm
subroutine psb_s_csmm ( alpha , a , x , beta , y , info , trans )
subroutine psb_s_csmm ( alpha , a , x , beta , y , info , trans )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_ s pk_) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_ d pk_) , intent ( inout ) :: y ( : , : )
real ( psb_ s pk_) , intent ( inout ) :: y ( : , : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
character , optional , intent ( in ) :: trans
end subroutine psb_s_csmm
end subroutine psb_s_csmm
subroutine psb_s_csmv ( alpha , a , x , beta , y , info , trans )
subroutine psb_s_csmv ( alpha , a , x , beta , y , info , trans )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_ s pk_) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_ d pk_) , intent ( inout ) :: y ( : )
real ( psb_ s pk_) , intent ( inout ) :: y ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
character , optional , intent ( in ) :: trans
end subroutine psb_s_csmv
end subroutine psb_s_csmv
subroutine psb_s_csmv_vect ( alpha , a , x , beta , y , info , trans )
subroutine psb_s_csmv_vect ( alpha , a , x , beta , y , info , trans )
use psb_s_vect_mod , only : psb_s_vect_type
use psb_s_vect_mod , only : psb_s_vect_type
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( in ) :: alpha , beta
real ( psb_ s pk_) , intent ( in ) :: alpha , beta
type ( psb_s_vect_type ) , intent ( inout ) :: x
type ( psb_s_vect_type ) , intent ( inout ) :: x
type ( psb_s_vect_type ) , intent ( inout ) :: y
type ( psb_s_vect_type ) , intent ( inout ) :: y
integer , intent ( out ) :: info
integer , intent ( out ) :: info
@ -622,28 +625,28 @@ module psb_s_mat_mod
interface psb_cssm
interface psb_cssm
subroutine psb_s_cssm ( alpha , a , x , beta , y , info , trans , scale , d )
subroutine psb_s_cssm ( alpha , a , x , beta , y , info , trans , scale , d )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_ s pk_) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_ d pk_) , intent ( inout ) :: y ( : , : )
real ( psb_ s pk_) , intent ( inout ) :: y ( : , : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans , scale
character , optional , intent ( in ) :: trans , scale
real ( psb_ d pk_) , intent ( in ) , optional :: d ( : )
real ( psb_ s pk_) , intent ( in ) , optional :: d ( : )
end subroutine psb_s_cssm
end subroutine psb_s_cssm
subroutine psb_s_cssv ( alpha , a , x , beta , y , info , trans , scale , d )
subroutine psb_s_cssv ( alpha , a , x , beta , y , info , trans , scale , d )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_ s pk_) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_ d pk_) , intent ( inout ) :: y ( : )
real ( psb_ s pk_) , intent ( inout ) :: y ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans , scale
character , optional , intent ( in ) :: trans , scale
real ( psb_ d pk_) , intent ( in ) , optional :: d ( : )
real ( psb_ s pk_) , intent ( in ) , optional :: d ( : )
end subroutine psb_s_cssv
end subroutine psb_s_cssv
subroutine psb_s_cssv_vect ( alpha , a , x , beta , y , info , trans , scale , d )
subroutine psb_s_cssv_vect ( alpha , a , x , beta , y , info , trans , scale , d )
use psb_s_vect_mod , only : psb_s_vect_type
use psb_s_vect_mod , only : psb_s_vect_type
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( in ) :: alpha , beta
real ( psb_ s pk_) , intent ( in ) :: alpha , beta
type ( psb_s_vect_type ) , intent ( inout ) :: x
type ( psb_s_vect_type ) , intent ( inout ) :: x
type ( psb_s_vect_type ) , intent ( inout ) :: y
type ( psb_s_vect_type ) , intent ( inout ) :: y
integer , intent ( out ) :: info
integer , intent ( out ) :: info
@ -654,85 +657,84 @@ module psb_s_mat_mod
interface
interface
function psb_s_maxval ( a ) result ( res )
function psb_s_maxval ( a ) result ( res )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) :: res
real ( psb_ s pk_) :: res
end function psb_s_maxval
end function psb_s_maxval
end interface
end interface
interface
interface
function psb_s_csnmi ( a ) result ( res )
function psb_s_csnmi ( a ) result ( res )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) :: res
real ( psb_ s pk_) :: res
end function psb_s_csnmi
end function psb_s_csnmi
end interface
end interface
interface
interface
function psb_s_csnm1 ( a ) result ( res )
function psb_s_csnm1 ( a ) result ( res )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) :: res
real ( psb_ s pk_) :: res
end function psb_s_csnm1
end function psb_s_csnm1
end interface
end interface
interface
interface
subroutine psb_s_rowsum ( d , a , info )
subroutine psb_s_rowsum ( d , a , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( out ) :: d ( : )
real ( psb_ s pk_) , intent ( out ) :: d ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_rowsum
end subroutine psb_s_rowsum
end interface
end interface
interface
interface
subroutine psb_s_arwsum ( d , a , info )
subroutine psb_s_arwsum ( d , a , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( out ) :: d ( : )
real ( psb_ s pk_) , intent ( out ) :: d ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_arwsum
end subroutine psb_s_arwsum
end interface
end interface
interface
interface
subroutine psb_s_colsum ( d , a , info )
subroutine psb_s_colsum ( d , a , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( out ) :: d ( : )
real ( psb_ s pk_) , intent ( out ) :: d ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_colsum
end subroutine psb_s_colsum
end interface
end interface
interface
interface
subroutine psb_s_aclsum ( d , a , info )
subroutine psb_s_aclsum ( d , a , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( out ) :: d ( : )
real ( psb_ s pk_) , intent ( out ) :: d ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_aclsum
end subroutine psb_s_aclsum
end interface
end interface
interface
interface
subroutine psb_s_get_diag ( a , d , info )
subroutine psb_s_get_diag ( a , d , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
real ( psb_ d pk_) , intent ( out ) :: d ( : )
real ( psb_ s pk_) , intent ( out ) :: d ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_get_diag
end subroutine psb_s_get_diag
end interface
end interface
interface psb_scal
interface psb_scal
subroutine psb_s_scal ( d , a , info )
subroutine psb_s_scal ( d , a , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( inout ) :: a
class ( psb_sspmat_type ) , intent ( inout ) :: a
real ( psb_ d pk_) , intent ( in ) :: d ( : )
real ( psb_ s pk_) , intent ( in ) :: d ( : )
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_scal
end subroutine psb_s_scal
subroutine psb_s_scals ( d , a , info )
subroutine psb_s_scals ( d , a , info )
import :: psb_sspmat_type , psb_ d pk_
import :: psb_sspmat_type , psb_ s pk_
class ( psb_sspmat_type ) , intent ( inout ) :: a
class ( psb_sspmat_type ) , intent ( inout ) :: a
real ( psb_ d pk_) , intent ( in ) :: d
real ( psb_ s pk_) , intent ( in ) :: d
integer , intent ( out ) :: info
integer , intent ( out ) :: info
end subroutine psb_s_scals
end subroutine psb_s_scals
end interface
end interface
@ -767,6 +769,7 @@ contains
end function psb_s_sizeof
end function psb_s_sizeof
function psb_s_get_fmt ( a ) result ( res )
function psb_s_get_fmt ( a ) result ( res )
implicit none
implicit none
class ( psb_sspmat_type ) , intent ( in ) :: a
class ( psb_sspmat_type ) , intent ( in ) :: a
@ -990,5 +993,4 @@ contains
end function psb_s_get_nz_row
end function psb_s_get_nz_row
end module psb_s_mat_mod
end module psb_s_mat_mod