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

psblas3:

Browse Source 
Makefile
 base/modules/psb_error_mod.F90
 base/newserial/Makefile
 base/newserial/psbn_base_mat_mod.f03
 base/newserial/psbn_d_base_mat_mod.f03
 base/newserial/psbn_d_coo_impl.f03
 base/newserial/psbn_d_csr_impl.f03
 base/newserial/psbn_d_csr_mat_mod.f03
 base/newserial/psbn_mat_impl.f03
 base/newserial/psbn_mat_mod.f03
 test/serial/d_coo_matgen.f03
 test/serial/d_matgen.f03
 test/serial/psbn_d_cxx_impl.f03
 test/serial/psbn_d_cxx_mat_mod.f03

Renamed various methods.
Tight binding of methods to outer objects.
psblas3-type-indexed
Salvatore Filippone 16 years ago
parent 1d21c81827
commit 7ee565006c
13 changed files with 715 additions and 355 deletions
Show Stats Download Patch File Download Diff File

2
base/modules/psb_error_mod.F90
Unescape Escape View File

@ -474,7 +474,7 @@ contains
case(600) case(600)
write (0,'("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1) write (0,'("Sparse Matrix and descriptors are in an invalid state for this subroutine call: ",i0)')i_e_d(1)
case(700) case(700)
write (0,'("Base version has been called: the actual derived type is incomplete!")') write (0,'("Base version has been called; the class implementation for ",a," may be incomplete!")') a_e_d
case (1121) case (1121)
write (0,'("Invalid state for sparse matrix A")') write (0,'("Invalid state for sparse matrix A")')

2
base/newserial/Makefile
Unescape Escape View File

@ -1,7 +1,7 @@
include ../../Make.inc include ../../Make.inc
MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o psbn_mat_mod.o\ MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o psbn_mat_mod.o\
psbn_mat_impl.o psbn_d_csr_mat_mod.o psbn_d_csr_impl.o psbn_d_csr_mat_mod.o psbn_d_csr_impl.o
LIBMOD= LIBMOD=

14
base/newserial/psbn_base_mat_mod.f03
Unescape Escape View File

@ -318,7 +318,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -342,7 +342,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -372,7 +372,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -401,7 +401,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -424,7 +424,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -446,7 +446,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -467,7 +467,7 @@ contains
! This is the base version. If we get here ! This is the base version. If we get here
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
call psb_errpush(700,name) call psb_errpush(700,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()

56
base/newserial/psbn_d_base_mat_mod.f03
Unescape Escape View File

@ -6,11 +6,11 @@ module psbn_d_base_mat_mod
contains contains
procedure, pass(a) :: d_base_csmv procedure, pass(a) :: d_base_csmv
procedure, pass(a) :: d_base_csmm procedure, pass(a) :: d_base_csmm
generic, public :: psbn_csmm => d_base_csmm, d_base_csmv generic, public :: csmm => d_base_csmm, d_base_csmv
procedure, pass(a) :: d_base_cssv procedure, pass(a) :: d_base_cssv
procedure, pass(a) :: d_base_cssm procedure, pass(a) :: d_base_cssm
generic, public :: psbn_cssm => d_base_cssm, d_base_cssv generic, public :: cssm => d_base_cssm, d_base_cssv
procedure, pass(a) :: csins procedure, pass(a) :: csput
procedure, pass(a) :: cp_to_coo procedure, pass(a) :: cp_to_coo
procedure, pass(a) :: cp_from_coo procedure, pass(a) :: cp_from_coo
procedure, pass(a) :: cp_to_fmt procedure, pass(a) :: cp_to_fmt
@ -21,7 +21,7 @@ module psbn_d_base_mat_mod
procedure, pass(a) :: mv_from_fmt procedure, pass(a) :: mv_from_fmt
end type psbn_d_base_sparse_mat end type psbn_d_base_sparse_mat
private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,& private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,&
& csins, cp_to_coo, cp_from_coo, cp_to_fmt, cp_from_fmt, & & csput, cp_to_coo, cp_from_coo, cp_to_fmt, cp_from_fmt, &
& mv_to_coo, mv_from_coo, mv_to_fmt, mv_from_fmt & mv_to_coo, mv_from_coo, mv_to_fmt, mv_from_fmt
@ -40,7 +40,7 @@ module psbn_d_base_mat_mod
procedure, pass(a) :: d_base_csmv => d_coo_csmv procedure, pass(a) :: d_base_csmv => d_coo_csmv
procedure, pass(a) :: d_base_cssm => d_coo_cssm procedure, pass(a) :: d_base_cssm => d_coo_cssm
procedure, pass(a) :: d_base_cssv => d_coo_cssv procedure, pass(a) :: d_base_cssv => d_coo_cssv
procedure, pass(a) :: csins => d_coo_csins procedure, pass(a) :: csput => d_coo_csput
procedure, pass(a) :: reallocate_nz => d_coo_reallocate_nz procedure, pass(a) :: reallocate_nz => d_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => d_coo_allocate_mnnz procedure, pass(a) :: allocate_mnnz => d_coo_allocate_mnnz
procedure, pass(a) :: cp_to_coo => d_cp_coo_to_coo procedure, pass(a) :: cp_to_coo => d_cp_coo_to_coo
@ -59,7 +59,7 @@ module psbn_d_base_mat_mod
end type psbn_d_coo_sparse_mat end type psbn_d_coo_sparse_mat
private :: d_coo_get_nzeros, d_coo_set_nzeros, & private :: d_coo_get_nzeros, d_coo_set_nzeros, &
& d_coo_csmm, d_coo_csmv, d_coo_cssm, d_coo_cssv, & & d_coo_csmm, d_coo_csmv, d_coo_cssm, d_coo_cssv, &
& d_coo_csins, d_coo_reallocate_nz, d_coo_allocate_mnnz, & & d_coo_csput, d_coo_reallocate_nz, d_coo_allocate_mnnz, &
& d_fix_coo, d_coo_free, d_coo_print, d_coo_get_fmt, & & d_fix_coo, d_coo_free, d_coo_print, d_coo_get_fmt, &
& d_cp_coo_to_coo, d_cp_coo_from_coo, & & d_cp_coo_to_coo, d_cp_coo_from_coo, &
& d_cp_coo_to_fmt, d_cp_coo_from_fmt & d_cp_coo_to_fmt, d_cp_coo_from_fmt
@ -168,7 +168,7 @@ module psbn_d_base_mat_mod
interface interface
subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_coo_csput_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod use psb_const_mod
import psbn_d_coo_sparse_mat import psbn_d_coo_sparse_mat
class(psbn_d_coo_sparse_mat), intent(inout) :: a class(psbn_d_coo_sparse_mat), intent(inout) :: a
@ -176,7 +176,7 @@ module psbn_d_base_mat_mod
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(:)
end subroutine d_coo_csins_impl end subroutine d_coo_csput_impl
end interface end interface
interface d_coo_cssm_impl interface d_coo_cssm_impl
@ -241,7 +241,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -267,7 +267,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -294,7 +294,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -320,7 +320,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -347,7 +347,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -373,7 +373,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -400,7 +400,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -426,7 +426,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -477,7 +477,7 @@ contains
end subroutine d_fix_coo end subroutine d_fix_coo
subroutine csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine csput(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
implicit none implicit none
@ -488,7 +488,7 @@ contains
integer, intent(in), optional :: gtl(:) integer, intent(in), optional :: gtl(:)
Integer :: err_act Integer :: err_act
character(len=20) :: name='csins' character(len=20) :: name='csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
@ -496,14 +496,14 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
end if end if
return return
end subroutine csins end subroutine csput
subroutine d_base_csmm(alpha,a,x,beta,y,info,trans) subroutine d_base_csmm(alpha,a,x,beta,y,info,trans)
use psb_error_mod use psb_error_mod
@ -523,7 +523,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -550,7 +550,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -578,7 +578,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -605,7 +605,7 @@ contains
! it means the derived class is incomplete, ! it means the derived class is incomplete,
! so we throw an error. ! so we throw an error.
info = 700 info = 700
call psb_errpush(info,name) call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then if (err_act /= psb_act_ret_) then
call psb_error() call psb_error()
@ -952,7 +952,7 @@ contains
end subroutine d_coo_set_nzeros end subroutine d_coo_set_nzeros
subroutine d_coo_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_coo_csput(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
implicit none implicit none
@ -964,7 +964,7 @@ contains
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_coo_csins' character(len=20) :: name='d_coo_csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5) integer :: nza, i,j,k, nzl, isza, int_err(5)
@ -999,7 +999,7 @@ contains
if (nz == 0) return if (nz == 0) return
nza = a%get_nzeros() nza = a%get_nzeros()
call d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) call d_coo_csput_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -1014,7 +1014,7 @@ contains
end if end if
return return
end subroutine d_coo_csins end subroutine d_coo_csput
subroutine d_coo_csmv(alpha,a,x,beta,y,info,trans) subroutine d_coo_csmv(alpha,a,x,beta,y,info,trans)

10
base/newserial/psbn_d_coo_impl.f03
Unescape Escape View File

@ -853,10 +853,10 @@ subroutine d_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
end subroutine d_coo_csmm_impl end subroutine d_coo_csmm_impl
subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_coo_csput_impl(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
use psbn_d_base_mat_mod, psb_protect_name => d_coo_csins_impl use psbn_d_base_mat_mod, psb_protect_name => d_coo_csput_impl
implicit none implicit none
class(psbn_d_coo_sparse_mat), intent(inout) :: a class(psbn_d_coo_sparse_mat), intent(inout) :: a
@ -867,7 +867,7 @@ subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_coo_csins_impl' character(len=20) :: name='d_coo_csput_impl'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5) integer :: nza, i,j,k, nzl, isza, int_err(5)
@ -905,7 +905,7 @@ subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
nza = a%get_nzeros() nza = a%get_nzeros()
isza = a%get_size() isza = a%get_size()
!!$ write(0,*) 'On entry to csins_impl: ',nza !!$ write(0,*) 'On entry to csput_impl: ',nza
if (a%is_bld()) then if (a%is_bld()) then
! Build phase. Must handle reallocations in a sensible way. ! Build phase. Must handle reallocations in a sensible way.
if (isza < (nza+nz)) then if (isza < (nza+nz)) then
@ -1303,7 +1303,7 @@ contains
end subroutine d_coo_srch_upd end subroutine d_coo_srch_upd
end subroutine d_coo_csins_impl end subroutine d_coo_csput_impl
subroutine d_cp_coo_to_coo_impl(a,b,info) subroutine d_cp_coo_to_coo_impl(a,b,info)

70
base/newserial/psbn_d_csr_impl.f03
Unescape Escape View File

@ -942,10 +942,10 @@ end subroutine d_csr_cssm_impl
subroutine d_csr_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_csr_csput_impl(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
use psbn_d_csr_mat_mod, psb_protect_name => d_csr_csins_impl use psbn_d_csr_mat_mod, psb_protect_name => d_csr_csput_impl
implicit none implicit none
class(psbn_d_csr_sparse_mat), intent(inout) :: a class(psbn_d_csr_sparse_mat), intent(inout) :: a
@ -956,7 +956,7 @@ subroutine d_csr_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_csr_csins' character(len=20) :: name='d_csr_csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5) integer :: nza, i,j,k, nzl, isza, int_err(5)
@ -1193,7 +1193,7 @@ contains
end subroutine d_csr_srch_upd end subroutine d_csr_srch_upd
end subroutine d_csr_csins_impl end subroutine d_csr_csput_impl
@ -1438,22 +1438,27 @@ subroutine d_mv_csr_to_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%mv_from_fmt(a,info) select type (b)
call b%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%mv_to_coo(b,info)
class default
call tmp%mv_from_fmt(a,info)
if (info == 0) call b%mv_from_coo(tmp,info)
end select
end subroutine d_mv_csr_to_fmt_impl end subroutine d_mv_csr_to_fmt_impl
subroutine d_mv_csr_from_fmt_impl(a,b,info) subroutine d_cp_csr_to_fmt_impl(a,b,info)
use psb_const_mod use psb_const_mod
use psb_realloc_mod use psb_realloc_mod
use psbn_d_base_mat_mod use psbn_d_base_mat_mod
use psbn_d_csr_mat_mod, psb_protect_name => d_mv_csr_from_fmt_impl use psbn_d_csr_mat_mod, psb_protect_name => d_cp_csr_to_fmt_impl
implicit none implicit none
class(psbn_d_csr_sparse_mat), intent(inout) :: a class(psbn_d_csr_sparse_mat), intent(in) :: a
class(psbn_d_base_sparse_mat), intent(inout) :: b class(psbn_d_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
!locals !locals
type(psbn_d_coo_sparse_mat) :: tmp type(psbn_d_coo_sparse_mat) :: tmp
@ -1465,23 +1470,28 @@ subroutine d_mv_csr_from_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%mv_from_fmt(b,info)
call a%mv_from_coo(tmp,info)
end subroutine d_mv_csr_from_fmt_impl select type (b)
class is (psbn_d_coo_sparse_mat)
call a%cp_to_coo(b,info)
class default
call tmp%cp_from_fmt(a,info)
if (info == 0) call b%mv_from_coo(tmp,info)
end select
end subroutine d_cp_csr_to_fmt_impl
subroutine d_cp_csr_to_fmt_impl(a,b,info) subroutine d_mv_csr_from_fmt_impl(a,b,info)
use psb_const_mod use psb_const_mod
use psb_realloc_mod use psb_realloc_mod
use psbn_d_base_mat_mod use psbn_d_base_mat_mod
use psbn_d_csr_mat_mod, psb_protect_name => d_cp_csr_to_fmt_impl use psbn_d_csr_mat_mod, psb_protect_name => d_mv_csr_from_fmt_impl
implicit none implicit none
class(psbn_d_csr_sparse_mat), intent(in) :: a class(psbn_d_csr_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(out) :: b class(psbn_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
!locals !locals
type(psbn_d_coo_sparse_mat) :: tmp type(psbn_d_coo_sparse_mat) :: tmp
@ -1493,10 +1503,16 @@ subroutine d_cp_csr_to_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%cp_from_fmt(a,info) select type (b)
call b%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%mv_from_coo(b,info)
class default
call tmp%mv_from_fmt(b,info)
if (info == 0) call a%mv_from_coo(tmp,info)
end select
end subroutine d_mv_csr_from_fmt_impl
end subroutine d_cp_csr_to_fmt_impl
subroutine d_cp_csr_from_fmt_impl(a,b,info) subroutine d_cp_csr_from_fmt_impl(a,b,info)
@ -1520,8 +1536,12 @@ subroutine d_cp_csr_from_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%cp_from_fmt(b,info) select type (b)
call a%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%cp_from_coo(b,info)
class default
call tmp%cp_from_fmt(b,info)
if (info == 0) call a%mv_from_coo(tmp,info)
end select
end subroutine d_cp_csr_from_fmt_impl end subroutine d_cp_csr_from_fmt_impl

16
base/newserial/psbn_d_csr_mat_mod.f03
Unescape Escape View File

@ -14,7 +14,7 @@ module psbn_d_csr_mat_mod
procedure, pass(a) :: d_base_cssm => d_csr_cssm procedure, pass(a) :: d_base_cssm => d_csr_cssm
procedure, pass(a) :: d_base_cssv => d_csr_cssv procedure, pass(a) :: d_base_cssv => d_csr_cssv
procedure, pass(a) :: reallocate_nz => d_csr_reallocate_nz procedure, pass(a) :: reallocate_nz => d_csr_reallocate_nz
procedure, pass(a) :: csins => d_csr_csins procedure, pass(a) :: csput => d_csr_csput
procedure, pass(a) :: allocate_mnnz => d_csr_allocate_mnnz procedure, pass(a) :: allocate_mnnz => d_csr_allocate_mnnz
procedure, pass(a) :: cp_to_coo => d_cp_csr_to_coo procedure, pass(a) :: cp_to_coo => d_cp_csr_to_coo
procedure, pass(a) :: cp_from_coo => d_cp_csr_from_coo procedure, pass(a) :: cp_from_coo => d_cp_csr_from_coo
@ -29,7 +29,7 @@ module psbn_d_csr_mat_mod
procedure, pass(a) :: get_fmt => d_csr_get_fmt procedure, pass(a) :: get_fmt => d_csr_get_fmt
end type psbn_d_csr_sparse_mat end type psbn_d_csr_sparse_mat
private :: d_csr_get_nzeros, d_csr_csmm, d_csr_csmv, d_csr_cssm, d_csr_cssv, & private :: d_csr_get_nzeros, d_csr_csmm, d_csr_csmv, d_csr_cssm, d_csr_cssv, &
& d_csr_csins, d_csr_reallocate_nz, d_csr_allocate_mnnz, & & d_csr_csput, d_csr_reallocate_nz, d_csr_allocate_mnnz, &
& d_csr_free, d_csr_print, d_csr_get_fmt, & & d_csr_free, d_csr_print, d_csr_get_fmt, &
& d_cp_csr_to_coo, d_cp_csr_from_coo, & & d_cp_csr_to_coo, d_cp_csr_from_coo, &
& d_mv_csr_to_coo, d_mv_csr_from_coo, & & d_mv_csr_to_coo, d_mv_csr_from_coo, &
@ -128,7 +128,7 @@ module psbn_d_csr_mat_mod
end interface end interface
interface interface
subroutine d_csr_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_csr_csput_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod use psb_const_mod
import psbn_d_csr_sparse_mat import psbn_d_csr_sparse_mat
class(psbn_d_csr_sparse_mat), intent(inout) :: a class(psbn_d_csr_sparse_mat), intent(inout) :: a
@ -136,7 +136,7 @@ module psbn_d_csr_mat_mod
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(:)
end subroutine d_csr_csins_impl end subroutine d_csr_csput_impl
end interface end interface
interface d_csr_cssm_impl interface d_csr_cssm_impl
@ -235,7 +235,7 @@ contains
end function d_csr_get_nzeros end function d_csr_get_nzeros
subroutine d_csr_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_csr_csput(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -247,7 +247,7 @@ contains
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_csr_csins' character(len=20) :: name='d_csr_csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5) integer :: nza, i,j,k, nzl, isza, int_err(5)
@ -282,7 +282,7 @@ contains
if (nz == 0) return if (nz == 0) return
call d_csr_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) call d_csr_csput_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -296,7 +296,7 @@ contains
return return
end if end if
return return
end subroutine d_csr_csins end subroutine d_csr_csput
subroutine d_csr_csmv(alpha,a,x,beta,y,info,trans) subroutine d_csr_csmv(alpha,a,x,beta,y,info,trans)

115
base/newserial/psbn_mat_impl.f03
Unescape Escape View File

@ -12,16 +12,16 @@ subroutine psbn_d_csall(nr,nc,a,info,nz)
info = 0 info = 0
call a%allocate(nr,nc,nz) call a%allocate(nr,nc,nz)
call a%set_state(psbn_spmat_bld_) call a%set_bld()
return return
end subroutine psbn_d_csall end subroutine psbn_d_csall
subroutine psbn_d_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine psbn_d_csput(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psbn_d_base_mat_mod use psbn_d_base_mat_mod
use psb_error_mod use psb_error_mod
use psbn_d_mat_mod, psb_protect_name => psbn_d_csins use psbn_d_mat_mod, psb_protect_name => psbn_d_csput
implicit none implicit none
type(psbn_d_sparse_mat), intent(inout) :: a type(psbn_d_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
@ -30,7 +30,7 @@ subroutine psbn_d_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
integer, intent(in), optional :: gtl(:) integer, intent(in), optional :: gtl(:)
Integer :: err_act Integer :: err_act
character(len=20) :: name='psbn_csins' character(len=20) :: name='psbn_csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0 info = 0
@ -42,7 +42,7 @@ subroutine psbn_d_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
endif endif
call a%a%csins(nz,val,ia,ja,imin,imax,jmin,jmax,info,gtl) call a%a%csput(nz,val,ia,ja,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -56,14 +56,14 @@ subroutine psbn_d_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
return return
end if end if
end subroutine psbn_d_csins end subroutine psbn_d_csput
subroutine psbn_d_spcnv(a,b,info,type,mold,upd,dupl) subroutine psbn_d_spcnv(a,b,info,type,mold,upd,dupl)
use psb_error_mod
use psb_string_mod
use psbn_d_mat_mod, psb_protect_name => psbn_d_spcnv use psbn_d_mat_mod, psb_protect_name => psbn_d_spcnv
use psb_realloc_mod
use psb_sort_mod
implicit none implicit none
type(psbn_d_sparse_mat), intent(in) :: a type(psbn_d_sparse_mat), intent(in) :: a
type(psbn_d_sparse_mat), intent(out) :: b type(psbn_d_sparse_mat), intent(out) :: b
@ -73,7 +73,80 @@ subroutine psbn_d_spcnv(a,b,info,type,mold,upd,dupl)
class(psbn_d_base_sparse_mat), intent(in), optional :: mold class(psbn_d_base_sparse_mat), intent(in), optional :: mold
write(0,*) 'TO BE IMPLEMENTED ' class(psbn_d_base_sparse_mat), allocatable :: altmp
Integer :: err_act
character(len=20) :: name='psbn_cscnv'
logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
if (present(dupl)) then
call b%set_dupl(dupl)
else if (a%is_bld()) then
! Does this make sense at all?? Who knows..
call b%set_dupl(psbn_dupl_def_)
end if
if (count( (/present(mold),present(type) /)) > 1) then
info = 583
call psb_errpush(info,name,a_err='TYPE, MOLD')
goto 9999
end if
if (present(mold)) then
allocate(altmp, source=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psbn_d_coo_sparse_mat :: altmp, stat=info)
case default
info = 136
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
end if
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
end if
call altmp%cp_from_fmt(a%a, info)
if (info /= 0) then
info = 4010
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,b%a)
call b%set_asb()
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
end subroutine psbn_d_spcnv end subroutine psbn_d_spcnv
@ -91,8 +164,6 @@ subroutine psbn_d_spcnv_ip(a,info,type,mold,dupl)
class(psbn_d_base_sparse_mat), allocatable :: altmp class(psbn_d_base_sparse_mat), allocatable :: altmp
class(psbn_d_base_sparse_mat), pointer :: aslct
type(psbn_d_csr_sparse_mat) :: csrtmp
Integer :: err_act Integer :: err_act
character(len=20) :: name='psbn_cscnv' character(len=20) :: name='psbn_cscnv'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -108,7 +179,7 @@ subroutine psbn_d_spcnv_ip(a,info,type,mold,dupl)
if (present(dupl)) then if (present(dupl)) then
call a%set_dupl(dupl) call a%set_dupl(dupl)
else else if (a%is_bld()) then
call a%set_dupl(psbn_dupl_def_) call a%set_dupl(psbn_dupl_def_)
end if end if
@ -135,23 +206,23 @@ subroutine psbn_d_spcnv_ip(a,info,type,mold,dupl)
goto 9999 goto 9999
end select end select
else else
allocate(altmp, source=csrtmp,stat=info) allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
end if end if
select type ( aa => a%a )
class is (psbn_d_coo_sparse_mat)
! Quick route from coo
call altmp%mv_from_coo(aa, info)
class default
call altmp%mv_from_fmt(aa, info)
end select
if (info /= 0) then if (info /= 0) then
info = 1121 info = 4000
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call altmp%mv_from_fmt(a%a, info)
if (info /= 0) then
info = 4010
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,a%a) call move_alloc(altmp,a%a)
call a%set_asb() call a%set_asb()

569
base/newserial/psbn_mat_mod.f03
Unescape Escape View File

@ -9,7 +9,7 @@ module psbn_d_mat_mod
class(psbn_d_base_sparse_mat), allocatable :: a class(psbn_d_base_sparse_mat), allocatable :: a
contains contains
! Setters
procedure, pass(a) :: set_nrows procedure, pass(a) :: set_nrows
procedure, pass(a) :: set_ncols procedure, pass(a) :: set_ncols
procedure, pass(a) :: set_dupl procedure, pass(a) :: set_dupl
@ -23,13 +23,12 @@ module psbn_d_mat_mod
procedure, pass(a) :: set_lower procedure, pass(a) :: set_lower
procedure, pass(a) :: set_triangle procedure, pass(a) :: set_triangle
procedure, pass(a) :: set_unit procedure, pass(a) :: set_unit
! Getters
procedure, pass(a) :: get_nrows procedure, pass(a) :: get_nrows
procedure, pass(a) :: get_ncols procedure, pass(a) :: get_ncols
procedure, pass(a) :: get_nzeros procedure, pass(a) :: get_nzeros
procedure, pass(a) :: get_size procedure, pass(a) :: get_size
procedure, pass(a) :: get_state procedure, pass(a) :: get_state
procedure, pass(a) :: get_dupl procedure, pass(a) :: get_dupl
procedure, pass(a) :: is_null procedure, pass(a) :: is_null
procedure, pass(a) :: is_bld procedure, pass(a) :: is_bld
@ -40,84 +39,54 @@ module psbn_d_mat_mod
procedure, pass(a) :: is_lower procedure, pass(a) :: is_lower
procedure, pass(a) :: is_triangle procedure, pass(a) :: is_triangle
procedure, pass(a) :: is_unit procedure, pass(a) :: is_unit
procedure, pass(a) :: get_neigh
procedure, pass(a) :: allocate_mnnz
procedure, pass(a) :: reallocate_nz
procedure, pass(a) :: free
procedure, pass(a) :: print => sparse_print
procedure, pass(a) :: get_fmt => sparse_get_fmt procedure, pass(a) :: get_fmt => sparse_get_fmt
generic, public :: allocate => allocate_mnnz ! Memory/data management
generic, public :: reallocate => reallocate_nz procedure, pass(a) :: csall
procedure, pass(a) :: free
procedure, pass(a) :: csput
procedure, pass(a) :: csget
procedure, pass(a) :: reall => reallocate_nz
procedure, pass(a) :: get_neigh
procedure, pass(a) :: d_cscnv
procedure, pass(a) :: d_cscnv_ip
generic, public :: cscnv => d_cscnv, d_cscnv_ip
procedure, pass(a) :: print => sparse_print
! Computational routines
procedure, pass(a) :: d_csmv procedure, pass(a) :: d_csmv
procedure, pass(a) :: d_csmm procedure, pass(a) :: d_csmm
generic, public :: psbn_csmm => d_csmm, d_csmv generic, public :: csmm => d_csmm, d_csmv
procedure, pass(a) :: d_cssv procedure, pass(a) :: d_cssv
procedure, pass(a) :: d_cssm procedure, pass(a) :: d_cssm
generic, public :: psbn_cssm => d_cssm, d_cssv generic, public :: cssm => d_cssm, d_cssv
end type psbn_d_sparse_mat end type psbn_d_sparse_mat
private :: get_nrows, get_ncols, get_nzeros, get_size, & private :: get_nrows, get_ncols, get_nzeros, get_size, &
& get_state, get_dupl, is_null, is_bld, is_upd, & & get_state, get_dupl, is_null, is_bld, is_upd, &
& is_asb, is_sorted, is_upper, is_lower, is_triangle, & & is_asb, is_sorted, is_upper, is_lower, is_triangle, &
& is_unit, get_neigh, allocate_mnnz, & & is_unit, get_neigh, csall, csput, csget, d_cscnv, d_cscnv_ip, &
& reallocate_nz, free, d_csmv, d_csmm, d_cssv, d_cssm, sparse_print, & & reallocate_nz, free, d_csmv, d_csmm, d_cssv, d_cssm, sparse_print, &
& set_nrows, set_ncols, set_dupl, set_state, set_null, set_bld, & & set_nrows, set_ncols, set_dupl, set_state, set_null, set_bld, &
& set_upd, set_asb, set_sorted, set_upper, set_lower, set_triangle, & & set_upd, set_asb, set_sorted, set_upper, set_lower, set_triangle, &
& set_unit & set_unit
contains
interface psbn_csall !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine psbn_d_csall(nr,nc,a,info,nz) !
use psbn_d_base_mat_mod !
import psbn_d_sparse_mat !
type(psbn_d_sparse_mat), intent(out) :: a ! Getters
integer, intent(in) :: nr,nc !
integer, intent(out) :: info !
integer, intent(in), optional :: nz !
end subroutine psbn_d_csall !
end interface !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
interface psbn_csins
subroutine psbn_d_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psbn_d_base_mat_mod
import psbn_d_sparse_mat
type(psbn_d_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 psbn_d_csins
end interface
interface psbn_cscnv
subroutine psbn_d_spcnv(a,b,info,type,mold,upd,dupl)
use psbn_d_base_mat_mod
import psbn_d_sparse_mat
type(psbn_d_sparse_mat), intent(in) :: a
type(psbn_d_sparse_mat), intent(out) :: b
integer, intent(out) :: info
integer, optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: type
class(psbn_d_base_sparse_mat), intent(in), optional :: mold
end subroutine psbn_d_spcnv
subroutine psbn_d_spcnv_ip(a,info,type,mold,dupl)
use psbn_d_base_mat_mod
import psbn_d_sparse_mat
type(psbn_d_sparse_mat), intent(inout) :: a
integer, intent(out) :: info
integer,optional, intent(in) :: dupl
character(len=*), optional, intent(in) :: type
class(psbn_d_base_sparse_mat), intent(in), optional :: mold
end subroutine psbn_d_spcnv_ip
end interface
contains
function sparse_get_fmt(a) result(res) function sparse_get_fmt(a) result(res)
@ -305,6 +274,88 @@ contains
end function is_sorted end function is_sorted
function get_nzeros(a) result(res)
use psb_error_mod
implicit none
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act, info
character(len=20) :: name='get_nzeros'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
res = a%a%get_nzeros()
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
end function get_nzeros
function get_size(a) result(res)
use psb_error_mod
implicit none
class(psbn_d_sparse_mat), intent(in) :: a
integer :: res
Integer :: err_act, info
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
info = 1121
call psb_errpush(info,name)
goto 9999
endif
res = a%a%get_size()
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 function get_size
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!
!
! Setters
!
!
!
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine set_nrows(m,a) subroutine set_nrows(m,a)
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -711,18 +762,37 @@ contains
end subroutine set_upper end subroutine set_upper
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!
!
! Data management
!
!
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
function get_nzeros(a) result(res)
subroutine sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
use psb_error_mod use psb_error_mod
implicit none implicit none
integer, intent(in) :: iout
class(psbn_d_sparse_mat), intent(in) :: a class(psbn_d_sparse_mat), intent(in) :: a
integer :: res integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:), ivc(:)
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='get_nzeros' character(len=20) :: name='sparse_print'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = 1121 info = 1121
@ -730,7 +800,8 @@ contains
goto 9999 goto 9999
endif endif
res = a%a%get_nzeros() call a%a%print(iout,iv,eirs,eics,head,ivr,ivc)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -742,19 +813,27 @@ contains
call psb_error() call psb_error()
return return
end if end if
return
end function get_nzeros end subroutine sparse_print
function get_size(a) result(res)
subroutine get_neigh(a,idx,neigh,n,info,lev)
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psbn_d_sparse_mat), intent(in) :: a class(psbn_d_sparse_mat), intent(in) :: a
integer :: res integer, intent(in) :: idx
integer, intent(out) :: n
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
Integer :: err_act, info Integer :: err_act
character(len=20) :: name='get_size' character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = 1121 info = 1121
@ -762,7 +841,9 @@ contains
goto 9999 goto 9999
endif endif
res = a%a%get_size() call a%a%get_neigh(idx,neigh,n,info,lev)
if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -776,33 +857,66 @@ contains
end if end if
return return
end function get_size end subroutine get_neigh
subroutine sparse_print(iout,a,iv,eirs,eics,head,ivr,ivc)
subroutine csall(nr,nc,a,info,nz)
use psbn_d_base_mat_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psbn_d_sparse_mat), intent(out) :: a
integer, intent(in) :: nr,nc
integer, intent(out) :: info
integer, intent(in), optional :: nz
integer, intent(in) :: iout Integer :: err_act
class(psbn_d_sparse_mat), intent(in) :: a character(len=20) :: name='csall'
integer, intent(in), optional :: iv(:) logical, parameter :: debug=.false.
integer, intent(in), optional :: eirs,eics
character(len=*), optional :: head
integer, intent(in), optional :: ivr(:), ivc(:) call psb_erractionsave(err_act)
info = 0
allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
if (info /= 0) then
info = 4000
call psb_errpush(info, name)
goto 9999
end if
call a%a%allocate(nr,nc,nz)
call a%set_bld()
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 csall
subroutine reallocate_nz(nz,a)
use psb_error_mod
implicit none
integer, intent(in) :: nz
class(psbn_d_sparse_mat), intent(inout) :: a
Integer :: err_act, info Integer :: err_act, info
character(len=20) :: name='sparse_print' character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = 1121 info = 1121
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
call a%a%print(iout,iv,eirs,eics,head,ivr,ivc) call a%a%reallocate(nz)
if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -816,23 +930,16 @@ contains
end if end if
return return
end subroutine sparse_print end subroutine reallocate_nz
subroutine get_neigh(a,idx,neigh,n,info,lev) subroutine free(a)
use psb_error_mod use psb_error_mod
implicit none implicit none
class(psbn_d_sparse_mat), intent(in) :: a class(psbn_d_sparse_mat), intent(inout) :: a
integer, intent(in) :: idx Integer :: err_act, info
integer, intent(out) :: n character(len=20) :: name='free'
integer, allocatable, intent(out) :: neigh(:)
integer, intent(out) :: info
integer, optional, intent(in) :: lev
Integer :: err_act
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then if (.not.allocated(a%a)) then
info = 1121 info = 1121
@ -840,9 +947,7 @@ contains
goto 9999 goto 9999
endif endif
call a%a%get_neigh(idx,neigh,n,info,lev) call a%a%free()
if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -856,63 +961,78 @@ contains
end if end if
return return
end subroutine get_neigh end subroutine free
subroutine allocate_mnnz(m,n,a,nz,type,mold) subroutine csput(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psbn_d_base_mat_mod
use psb_error_mod use psb_error_mod
use psb_string_mod
implicit none implicit none
integer, intent(in) :: m,n
class(psbn_d_sparse_mat), intent(inout) :: a class(psbn_d_sparse_mat), intent(inout) :: a
integer, intent(in), optional :: nz real(psb_dpk_), intent(in) :: val(:)
character(len=*), intent(in), optional :: type integer, intent(in) :: nz, ia(:), ja(:), imin,imax,jmin,jmax
class(psbn_d_base_sparse_mat), intent(in), optional :: mold integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
Integer :: err_act, info Integer :: err_act
character(len=20) :: name='allocate_mnnz' character(len=20) :: name='csput'
character(len=8) :: type_
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0 info = 0
if (allocated(a%a)) then call psb_erractionsave(err_act)
call a%a%free() if (.not.a%is_bld()) then
deallocate(a%a) info = 1121
end if call psb_errpush(info,name)
goto 9999
endif
if (present(mold)) then
allocate(a%a, source=mold, stat=info)
else call a%a%csput(nz,val,ia,ja,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999
if (present(type)) then call psb_erractionrestore(err_act)
type_ = psb_toupper(type) return
else
type_ = 'COO'
end if
select case(type) 9999 continue
case('COO') call psb_erractionrestore(err_act)
allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
! Add here a few other data structures inplemented by default.
!!$ case('CSR') if (err_act == psb_act_abort_) then
!!$ allocate(psbn_d_csr_sparse_mat :: a%a, stat=info) call psb_error()
return
end if
case default end subroutine csput
allocate(psbn_d_coo_sparse_mat :: a%a, stat=info)
end select
end if subroutine csget(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psbn_d_base_mat_mod
use psb_error_mod
implicit none
class(psbn_d_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
integer, intent(out) :: nz, ia(:), ja(:)
integer, intent(in) :: imin,imax,jmin,jmax
integer, intent(out) :: info
integer, intent(in), optional :: gtl(:)
if (info /= 0) then Integer :: err_act
info = 4010 character(len=20) :: name='csput'
logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121
call psb_errpush(info,name)
goto 9999 goto 9999
end if endif
info = 700
call psb_errpush(info,name,a_err='CSGET')
goto 9999
call a%a%allocate(m,n,nz)
!!$
!!$ call a%a%csget(nz,val,ia,ja,imin,imax,jmin,jmax,info,gtl)
!!$ if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -924,29 +1044,85 @@ contains
call psb_error() call psb_error()
return return
end if end if
return
end subroutine csget
end subroutine allocate_mnnz
subroutine reallocate_nz(nz,a) subroutine d_cscnv(a,b,info,type,mold,upd,dupl)
use psb_error_mod use psb_error_mod
use psb_string_mod
implicit none implicit none
integer, intent(in) :: nz class(psbn_d_sparse_mat), intent(in) :: a
class(psbn_d_sparse_mat), intent(inout) :: a class(psbn_d_sparse_mat), intent(out) :: b
Integer :: err_act, info integer, intent(out) :: info
character(len=20) :: name='reallocate_nz' integer,optional, intent(in) :: dupl, upd
character(len=*), optional, intent(in) :: type
class(psbn_d_base_sparse_mat), intent(in), optional :: mold
class(psbn_d_base_sparse_mat), allocatable :: altmp
Integer :: err_act
character(len=20) :: name='cscnv'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
if (.not.allocated(a%a)) then info = 0
call psb_erractionsave(err_act)
if (a%is_null()) then
info = 1121 info = 1121
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
call a%a%reallocate(nz) if (present(dupl)) then
call b%set_dupl(dupl)
else if (a%is_bld()) then
! Does this make sense at all?? Who knows..
call b%set_dupl(psbn_dupl_def_)
end if
if (info /= 0) goto 9999 if (count( (/present(mold),present(type) /)) > 1) then
info = 583
call psb_errpush(info,name,a_err='TYPE, MOLD')
goto 9999
end if
if (present(mold)) then
allocate(altmp, source=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psbn_d_coo_sparse_mat :: altmp, stat=info)
case default
info = 136
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
end if
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
end if
call altmp%cp_from_fmt(a%a, info)
if (info /= 0) then
info = 4010
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,b%a)
call b%set_asb()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -958,26 +1134,84 @@ contains
call psb_error() call psb_error()
return return
end if end if
return
end subroutine reallocate_nz end subroutine d_cscnv
subroutine free(a)
subroutine d_cscnv_ip(a,info,type,mold,dupl)
use psb_error_mod use psb_error_mod
use psb_string_mod
implicit none implicit none
class(psbn_d_sparse_mat), intent(inout) :: a class(psbn_d_sparse_mat), intent(inout) :: a
Integer :: err_act, info integer, intent(out) :: info
character(len=20) :: name='free' integer,optional, intent(in) :: dupl
character(len=*), optional, intent(in) :: type
class(psbn_d_base_sparse_mat), intent(in), optional :: mold
class(psbn_d_base_sparse_mat), allocatable :: altmp
Integer :: err_act
character(len=20) :: name='cscnv_ip'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
info = 0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (.not.allocated(a%a)) then
if (a%is_null()) then
info = 1121 info = 1121
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
call a%a%free() if (present(dupl)) then
call a%set_dupl(dupl)
else if (a%is_bld()) then
call a%set_dupl(psbn_dupl_def_)
end if
if (count( (/present(mold),present(type) /)) > 1) then
info = 583
call psb_errpush(info,name,a_err='TYPE, MOLD')
goto 9999
end if
if (present(mold)) then
allocate(altmp, source=mold,stat=info)
else if (present(type)) then
select case (psb_toupper(type))
case ('CSR')
allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
case ('COO')
allocate(psbn_d_coo_sparse_mat :: altmp, stat=info)
case default
info = 136
call psb_errpush(info,name,a_err=type)
goto 9999
end select
else
allocate(psbn_d_csr_sparse_mat :: altmp, stat=info)
end if
if (info /= 0) then
info = 4000
call psb_errpush(info,name)
goto 9999
end if
call altmp%mv_from_fmt(a%a, info)
if (info /= 0) then
info = 4010
call psb_errpush(info,name,a_err="mv_from")
goto 9999
end if
call move_alloc(altmp,a%a)
call a%set_asb()
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -989,9 +1223,26 @@ contains
call psb_error() call psb_error()
return return
end if end if
return
end subroutine free end subroutine d_cscnv_ip
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
!
!
! Computational routines
!
!
!
!
!
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
subroutine d_csmm(alpha,a,x,beta,y,info,trans) subroutine d_csmm(alpha,a,x,beta,y,info,trans)
@ -1014,7 +1265,7 @@ contains
goto 9999 goto 9999
endif endif
call a%a%psbn_csmm(alpha,x,beta,y,info,trans) call a%a%csmm(alpha,x,beta,y,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1050,7 +1301,7 @@ contains
goto 9999 goto 9999
endif endif
call a%a%psbn_csmm(alpha,x,beta,y,info,trans) call a%a%csmm(alpha,x,beta,y,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1086,7 +1337,7 @@ contains
goto 9999 goto 9999
endif endif
call a%a%psbn_cssm(alpha,x,beta,y,info,trans) call a%a%cssm(alpha,x,beta,y,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -1122,7 +1373,7 @@ contains
goto 9999 goto 9999
endif endif
call a%a%psbn_cssm(alpha,x,beta,y,info,trans) call a%a%cssm(alpha,x,beta,y,info,trans)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)

2
test/serial/d_coo_matgen.f03
Unescape Escape View File

@ -357,7 +357,7 @@ contains
endif endif
end do end do
call acoo%csins(element-1,val,irow,icol,1,nr,1,nr,info) call acoo%csput(element-1,val,irow,icol,1,nr,1,nr,info)
end do end do

29
test/serial/d_matgen.f03
Unescape Escape View File

@ -201,7 +201,7 @@ contains
t0 = psb_wtime() t0 = psb_wtime()
call psbn_csall(nr,nr,a_n,info) call a_n%csall(nr,nr,info)
talc = psb_wtime()-t0 talc = psb_wtime()-t0
@ -357,7 +357,7 @@ contains
endif endif
end do end do
call psbn_csins(element-1,val,irow,icol,a_n,1,nr,1,nr,info) call a_n%csput(element-1,val,irow,icol,1,nr,1,nr,info)
end do end do
@ -368,9 +368,9 @@ contains
call psb_errpush(info,name,a_err=ch_err) call psb_errpush(info,name,a_err=ch_err)
goto 9999 goto 9999
end if end if
call a_n%print(19)
t1 = psb_wtime() t1 = psb_wtime()
call psbn_cscnv(a_n,info,mold=acxx) call a_n%cscnv(info,mold=acsr)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
@ -380,18 +380,19 @@ contains
end if end if
tasb = psb_wtime()-t1 tasb = psb_wtime()-t1
call a_n%print(20) call a_n%print(20)
!!$ t1 = psb_wtime()
!!$ call psbn_cscnv(a_n,info,mold=acoo)
!!$ !!$
!!$ if(info /= 0) then t1 = psb_wtime()
!!$ info=4010 call a_n%cscnv(info,mold=acxx)
!!$ ch_err='asb rout.'
!!$ call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999
!!$ end if
!!$ tmov = psb_wtime()-t1
if(info /= 0) then
info=4010
ch_err='asb rout.'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
tmov = psb_wtime()-t1
call a_n%print(21)
!!$
if(iam == psb_root_) then if(iam == psb_root_) then
write(*,'("The matrix has been generated and is currently in ",a3," format.")')& write(*,'("The matrix has been generated and is currently in ",a3," format.")')&

85
test/serial/psbn_d_cxx_impl.f03
Unescape Escape View File

@ -942,10 +942,10 @@ end subroutine d_cxx_cssm_impl
subroutine d_cxx_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_cxx_csput_impl(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
use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csins_impl use psbn_d_cxx_mat_mod, psb_protect_name => d_cxx_csput_impl
implicit none implicit none
class(psbn_d_cxx_sparse_mat), intent(inout) :: a class(psbn_d_cxx_sparse_mat), intent(inout) :: a
@ -956,7 +956,7 @@ subroutine d_cxx_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_cxx_csins' character(len=20) :: name='d_cxx_csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5) integer :: nza, i,j,k, nzl, isza, int_err(5)
@ -1193,7 +1193,7 @@ contains
end subroutine d_cxx_srch_upd end subroutine d_cxx_srch_upd
end subroutine d_cxx_csins_impl end subroutine d_cxx_csput_impl
@ -1438,22 +1438,28 @@ subroutine d_mv_cxx_to_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%mv_from_fmt(a,info) select type (b)
call b%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%mv_to_coo(b,info)
class default
call tmp%mv_from_fmt(a,info)
if (info == 0) call b%mv_from_coo(tmp,info)
end select
end subroutine d_mv_cxx_to_fmt_impl end subroutine d_mv_cxx_to_fmt_impl
subroutine d_mv_cxx_from_fmt_impl(a,b,info)
subroutine d_cp_cxx_to_fmt_impl(a,b,info)
use psb_const_mod use psb_const_mod
use psb_realloc_mod use psb_realloc_mod
use psbn_d_base_mat_mod use psbn_d_base_mat_mod
use psbn_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_from_fmt_impl use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_to_fmt_impl
implicit none implicit none
class(psbn_d_cxx_sparse_mat), intent(inout) :: a class(psbn_d_cxx_sparse_mat), intent(in) :: a
class(psbn_d_base_sparse_mat), intent(inout) :: b class(psbn_d_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
!locals !locals
type(psbn_d_coo_sparse_mat) :: tmp type(psbn_d_coo_sparse_mat) :: tmp
@ -1465,23 +1471,26 @@ subroutine d_mv_cxx_from_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%mv_from_fmt(b,info) select type (b)
call a%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%cp_to_coo(b,info)
end subroutine d_mv_cxx_from_fmt_impl class default
call tmp%cp_from_fmt(a,info)
if (info == 0) call b%mv_from_coo(tmp,info)
end select
end subroutine d_cp_cxx_to_fmt_impl
subroutine d_cp_cxx_to_fmt_impl(a,b,info) subroutine d_cp_cxx_from_fmt_impl(a,b,info)
use psb_const_mod use psb_const_mod
use psb_realloc_mod use psb_realloc_mod
use psbn_d_base_mat_mod use psbn_d_base_mat_mod
use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_to_fmt_impl use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_from_fmt_impl
implicit none implicit none
class(psbn_d_cxx_sparse_mat), intent(in) :: a class(psbn_d_cxx_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(out) :: b class(psbn_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info integer, intent(out) :: info
!locals !locals
type(psbn_d_coo_sparse_mat) :: tmp type(psbn_d_coo_sparse_mat) :: tmp
@ -1493,22 +1502,26 @@ subroutine d_cp_cxx_to_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%cp_from_fmt(a,info) select type (b)
call b%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%cp_from_coo(b,info)
end subroutine d_cp_cxx_to_fmt_impl class default
call tmp%cp_from_fmt(b,info)
if (info == 0) call a%mv_from_coo(tmp,info)
end select
end subroutine d_cp_cxx_from_fmt_impl
subroutine d_cp_cxx_from_fmt_impl(a,b,info) subroutine d_mv_cxx_from_fmt_impl(a,b,info)
use psb_const_mod use psb_const_mod
use psb_realloc_mod use psb_realloc_mod
use psbn_d_base_mat_mod use psbn_d_base_mat_mod
use psbn_d_cxx_mat_mod, psb_protect_name => d_cp_cxx_from_fmt_impl use psbn_d_cxx_mat_mod, psb_protect_name => d_mv_cxx_from_fmt_impl
implicit none implicit none
class(psbn_d_cxx_sparse_mat), intent(inout) :: a class(psbn_d_cxx_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(in) :: b class(psbn_d_base_sparse_mat), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
!locals !locals
type(psbn_d_coo_sparse_mat) :: tmp type(psbn_d_coo_sparse_mat) :: tmp
@ -1520,8 +1533,12 @@ subroutine d_cp_cxx_from_fmt_impl(a,b,info)
info = 0 info = 0
call tmp%cp_from_fmt(b,info) select type (b)
call a%mv_from_coo(tmp,info) class is (psbn_d_coo_sparse_mat)
call a%mv_from_coo(b,info)
end subroutine d_cp_cxx_from_fmt_impl class default
call tmp%mv_from_fmt(b,info)
if (info == 0) call a%mv_from_coo(tmp,info)
end select
end subroutine d_mv_cxx_from_fmt_impl

36
test/serial/psbn_d_cxx_mat_mod.f03
Unescape Escape View File

@ -14,7 +14,7 @@ module psbn_d_cxx_mat_mod
procedure, pass(a) :: d_base_cssm => d_cxx_cssm procedure, pass(a) :: d_base_cssm => d_cxx_cssm
procedure, pass(a) :: d_base_cssv => d_cxx_cssv procedure, pass(a) :: d_base_cssv => d_cxx_cssv
procedure, pass(a) :: reallocate_nz => d_cxx_reallocate_nz procedure, pass(a) :: reallocate_nz => d_cxx_reallocate_nz
procedure, pass(a) :: csins => d_cxx_csins procedure, pass(a) :: csput => d_cxx_csput
procedure, pass(a) :: allocate_mnnz => d_cxx_allocate_mnnz procedure, pass(a) :: allocate_mnnz => d_cxx_allocate_mnnz
procedure, pass(a) :: cp_to_coo => d_cp_cxx_to_coo procedure, pass(a) :: cp_to_coo => d_cp_cxx_to_coo
procedure, pass(a) :: cp_from_coo => d_cp_cxx_from_coo procedure, pass(a) :: cp_from_coo => d_cp_cxx_from_coo
@ -29,7 +29,7 @@ module psbn_d_cxx_mat_mod
procedure, pass(a) :: get_fmt => d_cxx_get_fmt procedure, pass(a) :: get_fmt => d_cxx_get_fmt
end type psbn_d_cxx_sparse_mat end type psbn_d_cxx_sparse_mat
private :: d_cxx_get_nzeros, d_cxx_csmm, d_cxx_csmv, d_cxx_cssm, d_cxx_cssv, & private :: d_cxx_get_nzeros, d_cxx_csmm, d_cxx_csmv, d_cxx_cssm, d_cxx_cssv, &
& d_cxx_csins, d_cxx_reallocate_nz, d_cxx_allocate_mnnz, & & d_cxx_csput, d_cxx_reallocate_nz, d_cxx_allocate_mnnz, &
& d_cxx_free, d_cxx_print, d_cxx_get_fmt, & & d_cxx_free, d_cxx_print, d_cxx_get_fmt, &
& d_cp_cxx_to_coo, d_cp_cxx_from_coo, & & d_cp_cxx_to_coo, d_cp_cxx_from_coo, &
& d_mv_cxx_to_coo, d_mv_cxx_from_coo, & & d_mv_cxx_to_coo, d_mv_cxx_from_coo, &
@ -128,7 +128,7 @@ module psbn_d_cxx_mat_mod
end interface end interface
interface interface
subroutine d_cxx_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_cxx_csput_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod use psb_const_mod
import psbn_d_cxx_sparse_mat import psbn_d_cxx_sparse_mat
class(psbn_d_cxx_sparse_mat), intent(inout) :: a class(psbn_d_cxx_sparse_mat), intent(inout) :: a
@ -136,7 +136,7 @@ module psbn_d_cxx_mat_mod
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(:)
end subroutine d_cxx_csins_impl end subroutine d_cxx_csput_impl
end interface end interface
interface d_cxx_cssm_impl interface d_cxx_cssm_impl
@ -235,7 +235,7 @@ contains
end function d_cxx_get_nzeros end function d_cxx_get_nzeros
subroutine d_cxx_csins(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) subroutine d_cxx_csput(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod use psb_const_mod
use psb_error_mod use psb_error_mod
implicit none implicit none
@ -247,7 +247,7 @@ contains
Integer :: err_act Integer :: err_act
character(len=20) :: name='d_cxx_csins' character(len=20) :: name='d_cxx_csput'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer :: nza, i,j,k, nzl, isza, int_err(5) integer :: nza, i,j,k, nzl, isza, int_err(5)
@ -282,7 +282,7 @@ contains
if (nz == 0) return if (nz == 0) return
call d_cxx_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl) call d_cxx_csput_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -296,7 +296,7 @@ contains
return return
end if end if
return return
end subroutine d_cxx_csins end subroutine d_cxx_csput
subroutine d_cxx_csmv(alpha,a,x,beta,y,info,trans) subroutine d_cxx_csmv(alpha,a,x,beta,y,info,trans)
@ -602,21 +602,21 @@ contains
end subroutine d_cp_cxx_to_fmt end subroutine d_cp_cxx_to_fmt
subroutine d_cp_cxx_from_fmt(a,b,info) subroutine d_mv_cxx_to_coo(a,b,info)
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
implicit none implicit none
class(psbn_d_cxx_sparse_mat), intent(inout) :: a class(psbn_d_cxx_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(in) :: b class(psbn_d_coo_sparse_mat), intent(out) :: b
integer, intent(out) :: info integer, intent(out) :: info
Integer :: err_act Integer :: err_act
character(len=20) :: name='from_fmt' character(len=20) :: name='to_coo'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = 0 info = 0
call d_cp_cxx_from_fmt_impl(a,b,info) call d_mv_cxx_to_coo_impl(a,b,info)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -632,24 +632,24 @@ contains
end if end if
return return
end subroutine d_cp_cxx_from_fmt end subroutine d_mv_cxx_to_coo
subroutine d_mv_cxx_to_coo(a,b,info) subroutine d_cp_cxx_from_fmt(a,b,info)
use psb_error_mod use psb_error_mod
use psb_realloc_mod use psb_realloc_mod
implicit none implicit none
class(psbn_d_cxx_sparse_mat), intent(inout) :: a class(psbn_d_cxx_sparse_mat), intent(inout) :: a
class(psbn_d_coo_sparse_mat), intent(out) :: b class(psbn_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info integer, intent(out) :: info
Integer :: err_act Integer :: err_act
character(len=20) :: name='to_coo' character(len=20) :: name='from_fmt'
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = 0 info = 0
call d_mv_cxx_to_coo_impl(a,b,info) call d_cp_cxx_from_fmt_impl(a,b,info)
if (info /= 0) goto 9999 if (info /= 0) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -665,7 +665,7 @@ contains
end if end if
return return
end subroutine d_mv_cxx_to_coo end subroutine d_cp_cxx_from_fmt
subroutine d_mv_cxx_from_coo(a,b,info) subroutine d_mv_cxx_from_coo(a,b,info)
use psb_error_mod use psb_error_mod

Write Preview
Loading…
Cancel
Save