@ -12,11 +12,269 @@ module psbn_d_base_mat_mod
procedure , pass ( a ) :: d_base_cssm
procedure , pass ( a ) :: d_base_cssm
generic , public :: psbn_cssm = > d_base_cssm , d_base_cssv
generic , public :: psbn_cssm = > d_base_cssm , d_base_cssv
procedure , pass ( a ) :: csins
procedure , pass ( a ) :: csins
procedure , pass ( a ) :: to_coo
procedure , pass ( a ) :: from_coo
end type psbn_d_base_sparse_mat
end type psbn_d_base_sparse_mat
type , extends ( psbn_d_base_sparse_mat ) :: psbn_d_coo_sparse_mat
integer :: nnz
integer , allocatable :: ia ( : ) , ja ( : )
real ( psb_dpk_ ) , allocatable :: val ( : )
contains
procedure , pass ( a ) :: get_nzeros = > d_coo_get_nzeros
procedure , pass ( a ) :: set_nzeros = > d_coo_set_nzeros
procedure , pass ( a ) :: d_base_csmm = > d_coo_csmm
procedure , pass ( a ) :: d_base_csmv = > d_coo_csmv
procedure , pass ( a ) :: d_base_cssm = > d_coo_cssm
procedure , pass ( a ) :: d_base_cssv = > d_coo_cssv
procedure , pass ( a ) :: csins = > d_coo_csins
procedure , pass ( a ) :: reallocate_nz = > d_coo_reallocate_nz
procedure , pass ( a ) :: to_coo = > d_coo_to_coo
procedure , pass ( a ) :: from_coo = > d_coo_from_coo
procedure , pass ( a ) :: fix = > d_fix_coo
end type psbn_d_coo_sparse_mat
interface
subroutine d_fix_coo_impl ( a , info , idir )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
integer , intent ( out ) :: info
integer , intent ( in ) , optional :: idir
end subroutine d_fix_coo_impl
end interface
interface
subroutine d_coo_to_coo_impl ( a , b , info )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
class ( psbn_d_coo_sparse_mat ) , intent ( out ) :: b
integer , intent ( out ) :: info
end subroutine d_coo_to_coo_impl
end interface
interface
subroutine d_coo_from_coo_impl ( a , b , info )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: b
integer , intent ( out ) :: info
end subroutine d_coo_from_coo_impl
end interface
interface
subroutine d_coo_csins_impl ( nz , val , ia , ja , a , imin , imax , jmin , jmax , info , gtl )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
real ( psb_dpk_ ) , intent ( in ) :: val ( : )
integer , intent ( in ) :: nz , ia ( : ) , ja ( : ) , imin , imax , jmin , jmax
integer , intent ( out ) :: info
integer , intent ( in ) , optional :: gtl ( : )
end subroutine d_coo_csins_impl
end interface
interface d_coo_cssm_impl
subroutine d_coo_cssv_impl ( alpha , a , x , beta , y , info , trans )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
end subroutine d_coo_cssv_impl
subroutine d_coo_cssm_impl ( alpha , a , x , beta , y , info , trans )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : , : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
end subroutine d_coo_cssm_impl
end interface
interface d_coo_csmm_impl
subroutine d_coo_csmv_impl ( alpha , a , x , beta , y , info , trans )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
end subroutine d_coo_csmv_impl
subroutine d_coo_csmm_impl ( alpha , a , x , beta , y , info , trans )
use psb_const_mod
import psbn_d_coo_sparse_mat
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : , : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
end subroutine d_coo_csmm_impl
end interface
contains
contains
subroutine to_coo ( a , b , info )
use psb_error_mod
use psb_realloc_mod
class ( psbn_d_base_sparse_mat ) , intent ( in ) :: a
class ( psbn_d_coo_sparse_mat ) , intent ( out ) :: b
integer , intent ( out ) :: info
Integer :: err_act
character ( len = 20 ) :: name = 'to_coo'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
! This is the base version . If we get here
! it means the derived class is incomplete ,
! so we throw an error .
info = 700
call psb_errpush ( info , name )
if ( err_act / = psb_act_ret_ ) then
call psb_error ( )
end if
return
end subroutine to_coo
subroutine d_fix_coo ( a , info , idir )
use psb_error_mod
use psb_const_mod
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
integer , intent ( out ) :: info
integer , intent ( in ) , optional :: idir
Integer :: err_act
character ( len = 20 ) :: name = 'fix_coo'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
info = 0
call d_fix_coo_impl ( a , info , idir )
if ( info / = 0 ) go to 9999
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
call psb_errpush ( info , name )
if ( err_act / = psb_act_ret_ ) then
call psb_error ( )
end if
return
end subroutine d_fix_coo
subroutine d_coo_to_coo ( a , b , info )
use psb_error_mod
use psb_realloc_mod
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
class ( psbn_d_coo_sparse_mat ) , intent ( out ) :: b
integer , intent ( out ) :: info
Integer :: err_act
character ( len = 20 ) :: name = 'to_coo'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
info = 0
call d_coo_to_coo_impl ( a , b , info )
if ( info / = 0 ) go to 9999
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
call psb_errpush ( info , name )
if ( err_act / = psb_act_ret_ ) then
call psb_error ( )
end if
return
end subroutine d_coo_to_coo
subroutine d_coo_from_coo ( a , b , info )
use psb_error_mod
use psb_realloc_mod
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: b
integer , intent ( out ) :: info
Integer :: err_act
character ( len = 20 ) :: name = 'from_coo'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
info = 0
call d_coo_from_coo_impl ( a , b , info )
if ( info / = 0 ) go to 9999
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
call psb_errpush ( info , name )
if ( err_act / = psb_act_ret_ ) then
call psb_error ( )
end if
return
end subroutine d_coo_from_coo
subroutine from_coo ( a , b , info )
use psb_error_mod
use psb_realloc_mod
class ( psbn_d_base_sparse_mat ) , intent ( inout ) :: a
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: b
integer , intent ( out ) :: info
Integer :: err_act
character ( len = 20 ) :: name = 'from_coo'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
! This is the base version . If we get here
! it means the derived class is incomplete ,
! so we throw an error .
info = 700
call psb_errpush ( info , name )
if ( err_act / = psb_act_ret_ ) then
call psb_error ( )
end if
return
end subroutine from_coo
subroutine csins ( nz , val , ia , ja , a , imin , imax , jmin , jmax , info , gtl )
subroutine csins ( nz , val , ia , ja , a , imin , imax , jmin , jmax , info , gtl )
use psb_error_mod
use psb_error_mod
use psb_realloc_mod
use psb_realloc_mod
@ -150,4 +408,305 @@ contains
end subroutine d_base_cssv
end subroutine d_base_cssv
subroutine d_coo_reallocate_nz ( nz , a )
use psb_error_mod
use psb_realloc_mod
integer , intent ( in ) :: nz
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
Integer :: err_act
character ( len = 20 ) :: name = 'd_coo_reallocate_nz'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
call psb_realloc ( nx , a % ia , a % ja , a % val , info )
if ( info / = 0 ) then
call psb_errpush ( 4000 , name )
go to 9999
end if
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( )
return
end if
return
end subroutine d_coo_reallocate_nz
function d_coo_get_nzeros ( a ) result ( res )
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
integer :: res
res = a % nnz
end function d_coo_get_nzeros
subroutine d_coo_set_nzeros ( nz , a )
integer , intent ( in ) :: nz
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
a % nnz = nz
end subroutine d_coo_set_nzeros
subroutine d_coo_csins ( nz , val , ia , ja , a , imin , imax , jmin , jmax , info , gtl )
use psb_error_mod
use psb_realloc_mod
class ( psbn_d_coo_sparse_mat ) , intent ( inout ) :: a
real ( psb_dpk_ ) , intent ( in ) :: val ( : )
integer , intent ( in ) :: nz , ia ( : ) , ja ( : ) , imin , imax , jmin , jmax
integer , intent ( out ) :: info
integer , intent ( in ) , optional :: gtl ( : )
Integer :: err_act
character ( len = 20 ) :: name = 'd_coo_csins'
logical , parameter :: debug = . false .
integer :: nza , i , j , k , nzl , isza , int_err ( 5 )
call psb_erractionsave ( err_act )
info = 0
if ( nz < = 0 ) then
info = 10
int_err ( 1 ) = 1
call psb_errpush ( info , name , i_err = int_err )
go to 9999
end if
if ( size ( ia ) < nz ) then
info = 35
int_err ( 1 ) = 2
call psb_errpush ( info , name , i_err = int_err )
go to 9999
end if
if ( size ( ja ) < nz ) then
info = 35
int_err ( 1 ) = 3
call psb_errpush ( info , name , i_err = int_err )
go to 9999
end if
if ( size ( val ) < nz ) then
info = 35
int_err ( 1 ) = 4
call psb_errpush ( info , name , i_err = int_err )
go to 9999
end if
if ( nz == 0 ) return
call d_coo_csins_impl ( nz , val , ia , ja , a , imin , imax , jmin , jmax , info , gtl )
if ( info / = 0 ) go to 9999
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( )
return
end if
return
end subroutine d_coo_csins
subroutine d_coo_csmv ( alpha , a , x , beta , y , info , trans )
use psb_error_mod
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
character :: trans_
integer :: i , j , k , m , n , nnz , ir , jc
real ( psb_dpk_ ) :: acc
logical :: tra
Integer :: err_act
character ( len = 20 ) :: name = 'd_coo_csmv'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
if ( . not . a % is_asb ( ) ) then
info = 1121
call psb_errpush ( info , name )
go to 9999
endif
call d_coo_csmm_impl ( alpha , a , x , beta , y , info , trans )
if ( info / = 0 ) go to 9999
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( )
return
end if
return
end subroutine d_coo_csmv
subroutine d_coo_csmm ( alpha , a , x , beta , y , info , trans )
use psb_error_mod
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : , : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
character :: trans_
integer :: i , j , k , m , n , nnz , ir , jc , nc
real ( psb_dpk_ ) , allocatable :: acc ( : )
logical :: tra
Integer :: err_act
character ( len = 20 ) :: name = 'd_coo_csmm'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
call d_coo_csmm_impl ( alpha , a , x , beta , y , info , trans )
if ( info / = 0 ) go to 9999
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( )
return
end if
return
end subroutine d_coo_csmm
subroutine d_coo_cssv ( alpha , a , x , beta , y , info , trans )
use psb_error_mod
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
character :: trans_
integer :: i , j , k , m , n , nnz , ir , jc
real ( psb_dpk_ ) :: acc
real ( psb_dpk_ ) , allocatable :: tmp ( : )
logical :: tra
Integer :: err_act
character ( len = 20 ) :: name = 'd_coo_cssv'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
if ( . not . a % is_asb ( ) ) then
info = 1121
call psb_errpush ( info , name )
go to 9999
endif
if ( . not . ( a % is_triangle ( ) ) ) then
write ( 0 , * ) 'Called SM on a non-triangular mat!'
info = 1121
call psb_errpush ( info , name )
go to 9999
end if
call d_coo_cssm_impl ( alpha , a , x , beta , y , info , trans )
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( )
return
end if
return
end subroutine d_coo_cssv
subroutine d_coo_cssm ( alpha , a , x , beta , y , info , trans )
use psb_error_mod
class ( psbn_d_coo_sparse_mat ) , intent ( in ) :: a
real ( psb_dpk_ ) , intent ( in ) :: alpha , beta , x ( : , : )
real ( psb_dpk_ ) , intent ( inout ) :: y ( : , : )
integer , intent ( out ) :: info
character , optional , intent ( in ) :: trans
character :: trans_
integer :: i , j , k , m , n , nnz , ir , jc , nc
real ( psb_dpk_ ) :: acc
real ( psb_dpk_ ) , allocatable :: tmp ( : , : )
logical :: tra
Integer :: err_act
character ( len = 20 ) :: name = 'd_coo_csmm'
logical , parameter :: debug = . false .
call psb_erractionsave ( err_act )
if ( . not . a % is_asb ( ) ) then
info = 1121
call psb_errpush ( info , name )
go to 9999
endif
if ( . not . ( a % is_triangle ( ) ) ) then
write ( 0 , * ) 'Called SM on a non-triangular mat!'
info = 1121
call psb_errpush ( info , name )
go to 9999
end if
call d_coo_cssm_impl ( alpha , a , x , beta , y , info , trans )
call psb_erractionrestore ( err_act )
return
9999 continue
call psb_erractionrestore ( err_act )
if ( err_act == psb_act_abort_ ) then
call psb_error ( )
return
end if
return
end subroutine d_coo_cssm
end module psbn_d_base_mat_mod
end module psbn_d_base_mat_mod