fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-15 10:29:10 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
added someitems about SPCNV.
This commit is contained in:
Salvatore Filippone
2009-08-29 15:29:53 +00:00
parent 7d8a6bd486
commit 30c06b3b8f
5 changed files with 471 additions and 240 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/newserial/Makefile
+2 -2
View File
@@ -1,7 +1,7 @@
include ../../Make.inc
MODULES = psbn_base_mat_mod.o psbn_d_base_mat_mod.o psbn_d_coo_impl.o psbn_mat_mod.o\
psbn_d_csr_mat_mod.o psbn_d_csr_impl.o
psbn_mat_impl.o psbn_d_csr_mat_mod.o psbn_d_csr_impl.o
LIBMOD=
@@ -20,7 +20,7 @@ psbn_mat_mod.o: psbn_base_mat_mod.o
psbn_coo_mat.o psbn_csr_mat.o: psbn_d_base_mat_mod.o
psbn_d_csr_impl.o: psbn_d_csr_mat_mod.o
psbn_d_mat_impl.o: psbn_d_base_mat_mod.o
psbn_mat_impl.o: psbn_mat_mod.o
clean:
/bin/rm -f $(MODULES) $(OBJS) $(MPFOBJS) *$(.mod)
base/newserial/README
+53 -53
View File
@@ -28,78 +28,78 @@ Design principles for this directory.
OUTER object which is what the rest of the library sees, as
follows:
type :: psbn_d_sparse_mat
type :: psbn_d_sparse_mat
class(psbn_d_base_sparse_mat), allocatable :: a
class(psbn_d_base_sparse_mat), allocatable :: a
end type psbn_d_sparse_mat
type(psbn_d_sparse_mat) :: a
end type psbn_d_sparse_mat
type(psbn_d_sparse_mat) :: a
In this way we can have an outer object whose type is stable
both statically (at compile time) and at runtime, while at runtime
the type of the inner object switches from COO to CSR to whatever as
needed. All of the methods are simply thrown onto the corresponding
methods of the (allocatable, polymorphic) component A%A as needed
(provided the component is allocated, that is).
This is what is called a STATE design pattern (different from the
internal state we discussed above).
In this way we can have an outer object whose type is stable
both statically (at compile time) and at runtime, while at runtime
the type of the inner object switches from COO to CSR to whatever as
needed. All of the methods are simply thrown onto the corresponding
methods of the (allocatable, polymorphic) component A%A as needed
(provided the component is allocated, that is).
This is what is called a STATE design pattern (different from the
internal state we discussed above).
As an example, consider the allocate/build/assembly cycle:
the outer code would do the following:
1. Allocate(psbn_d_coo_sparse_mat :: a%a)
As an example, consider the allocate/build/assembly cycle:
the outer code would do the following:
1. Allocate(psbn_d_coo_sparse_mat :: a%a)
2. During the build loop a call to A%CSINS() gets translated into
CALL A%A%CSINS()
2. During the build loop a call to A%CSINS() gets translated into
CALL A%A%CSINS()
3. At assembly time the code would do the following
subroutine psb_spasb(a,....)
type(psbn_d_sparse_mat), intent(inout) :: a
3. At assembly time the code would do the following
subroutine psb_spasb(a,....)
type(psbn_d_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), allocatable :: temp
class(psbn_d_base_sparse_mat), allocatable :: temp
select case (TYPE)
case('CSR')
allocate(psbn_d_csr_sparse_mat :: temp, stat=info)
end select
call temp%from_coo(a%a)
call a%a%free()
call move_alloc(temp,a%a)
select case (TYPE)
case('CSR')
allocate(psbn_d_csr_sparse_mat :: temp, stat=info)
end select
call temp%from_coo(a%a)
call a%a%free()
call move_alloc(temp,a%a)
4. Note in the above that to_coo, from_coo are defined so that every
conceivable storage representation provides just 2 conversion
routines, avoiding quadratic explosion. But since all have to
provide them, the to_coo/from_coo is defined in d_base_mat_mod
together with d_coo_sparse_mat, which enjoys the "eldest child"
status with respect to all the other types derived from
d_base_sparse_mat (its "siblings").
4. Note in the above that to_coo, from_coo are defined so that every
conceivable storage representation provides just 2 conversion
routines, avoiding quadratic explosion. But since all have to
provide them, the to_coo/from_coo is defined in d_base_mat_mod
together with d_coo_sparse_mat, which enjoys the "eldest child"
status with respect to all the other types derived from
d_base_sparse_mat (its "siblings").
5. How does a user add a new storage format? Very simple. After
deriving the class and implementing all the necessary methods,
the user declares in the program a dummy variable of the new
inner type
5. How does a user add a new storage format? Very simple. After
deriving the class and implementing all the necessary methods,
the user declares in the program a dummy variable of the new
inner type
type(X_YYY_sparse_mat) :: reftype
type(X_YYY_sparse_mat) :: reftype
then calls
call psb_spasb(a,....,mold=reftype)
then calls
call psb_spasb(a,....,mold=reftype)
In psb_spasb we have
class(psbn_d_base_sparse_mat), intent(in), optional :: mold
In psb_spasb we have
class(psbn_d_base_sparse_mat), intent(in), optional :: mold
if (present(mold)) then
if (present(mold)) then
allocate(temp,source=mold,stat=info)
end select
call temp%from_coo(a%a)
call a%a%free()
call move_alloc(temp,a%a)
end select
call temp%from_coo(a%a)
call a%a%free()
call move_alloc(temp,a%a)
AND IT'S DONE! Nothing else in the library requires the explicit
knowledge of type of MOLD.
AND IT'S DONE! Nothing else in the library requires the explicit
knowledge of type of MOLD.
User exercise: start by adding CSR in this way.
(waiting for a couple of bug fixes from NAG to actually test this.)
User exercise: start by adding CSR in this way.
(waiting for a couple of bug fixes from NAG to actually test this.)
base/newserial/psbn_d_base_mat_mod.f03
+320 -185
View File
@@ -1,4 +1,3 @@
module psbn_d_base_mat_mod
use psbn_base_mat_mod
@@ -14,20 +13,21 @@ module psbn_d_base_mat_mod
procedure, pass(a) :: csins
procedure, pass(a) :: to_coo
procedure, pass(a) :: from_coo
procedure, pass(a) :: to_fmt
procedure, pass(a) :: from_fmt
end type psbn_d_base_sparse_mat
private :: d_base_csmv, d_base_csmm, d_base_cssv, d_base_cssm,&
& csins, to_coo, from_coo
& csins, to_coo, from_coo, to_fmt, from_fmt
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
@@ -38,19 +38,21 @@ module psbn_d_base_mat_mod
procedure, pass(a) :: reallocate_nz => d_coo_reallocate_nz
procedure, pass(a) :: allocate_mnnz => d_coo_allocate_mnnz
procedure, pass(a) :: allocate_mn => d_coo_allocate_mn
procedure, pass(a) :: to_coo => d_coo_to_coo
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
procedure, pass(a) :: free => d_coo_free
procedure, pass(a) :: to_fmt => d_coo_to_fmt
procedure, pass(a) :: from_fmt => d_coo_from_fmt
procedure, pass(a) :: fix => d_fix_coo
procedure, pass(a) :: free => d_coo_free
end type psbn_d_coo_sparse_mat
private :: d_coo_get_nzeros, d_coo_set_nzeros, &
& 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_allocate_mn, d_coo_to_coo, d_coo_from_coo, &
& d_fix_coo, d_coo_free
interface
subroutine d_fix_coo_impl(a,info,idir)
use psb_const_mod
@@ -70,7 +72,7 @@ module psbn_d_base_mat_mod
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
@@ -81,6 +83,26 @@ module psbn_d_base_mat_mod
end subroutine d_coo_from_coo_impl
end interface
interface
subroutine d_coo_to_fmt_impl(a,b,info)
use psb_const_mod
import psbn_d_coo_sparse_mat, psbn_d_base_sparse_mat
class(psbn_d_coo_sparse_mat), intent(in) :: a
class(psbn_d_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info
end subroutine d_coo_to_fmt_impl
end interface
interface
subroutine d_coo_from_fmt_impl(a,b,info)
use psb_const_mod
import psbn_d_coo_sparse_mat, psbn_d_base_sparse_mat
class(psbn_d_coo_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
end subroutine d_coo_from_fmt_impl
end interface
interface
subroutine d_coo_csins_impl(nz,val,ia,ja,a,imin,imax,jmin,jmax,info,gtl)
use psb_const_mod
@@ -92,7 +114,7 @@ module psbn_d_base_mat_mod
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
@@ -113,7 +135,7 @@ module psbn_d_base_mat_mod
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
@@ -136,8 +158,8 @@ module psbn_d_base_mat_mod
end interface
contains
subroutine to_coo(a,b,info)
use psb_error_mod
@@ -145,26 +167,103 @@ contains
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 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 to_fmt(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_base_sparse_mat), intent(in) :: a
class(psbn_d_base_sparse_mat), intent(out) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='to_fmt'
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_fmt
subroutine from_fmt(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_base_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='from_fmt'
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_fmt
subroutine d_fix_coo(a,info,idir)
use psb_error_mod
use psb_const_mod
@@ -174,55 +273,29 @@ contains
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) goto 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 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)
use psb_error_mod
@@ -232,25 +305,25 @@ contains
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='csins'
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 csins
subroutine d_base_csmm(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_base_sparse_mat), intent(in) :: a
@@ -258,25 +331,25 @@ contains
real(psb_dpk_), intent(inout) :: y(:,:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
Integer :: err_act
character(len=20) :: name='d_base_csmm'
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 d_base_csmm
subroutine d_base_csmv(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_base_sparse_mat), intent(in) :: a
@@ -284,26 +357,26 @@ contains
real(kind(1.d0)), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
Integer :: err_act
character(len=20) :: name='d_base_csmv'
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 d_base_csmv
subroutine d_base_cssm(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_base_sparse_mat), intent(in) :: a
@@ -315,21 +388,21 @@ contains
Integer :: err_act
character(len=20) :: name='d_base_cssm'
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 d_base_cssm
subroutine d_base_cssv(alpha,a,x,beta,y,info,trans)
use psb_error_mod
class(psbn_d_base_sparse_mat), intent(in) :: a
@@ -337,56 +410,56 @@ contains
real(psb_dpk_), intent(inout) :: y(:)
integer, intent(out) :: info
character, optional, intent(in) :: trans
Integer :: err_act
character(len=20) :: name='d_base_cssv'
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 d_base_cssv
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) goto 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)
@@ -395,31 +468,93 @@ contains
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) goto 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 d_coo_to_fmt(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_coo_sparse_mat), intent(in) :: a
class(psbn_d_base_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_fmt_impl(a,b,info)
if (info /= 0) goto 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_fmt
subroutine d_coo_from_fmt(a,b,info)
use psb_error_mod
use psb_realloc_mod
class(psbn_d_coo_sparse_mat), intent(inout) :: a
class(psbn_d_base_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_fmt_impl(a,b,info)
if (info /= 0) goto 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_fmt
subroutine d_coo_reallocate_nz(nz,a)
use psb_error_mod
use psb_realloc_mod
@@ -428,47 +563,47 @@ contains
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)
goto 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
@@ -477,16 +612,16 @@ contains
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
@@ -499,7 +634,7 @@ contains
call psb_errpush(info,name,i_err=int_err)
goto 9999
end if
if (size(ja) < nz) then
info = 35
int_err(1)=3
@@ -512,27 +647,27 @@ contains
call psb_errpush(info,name,i_err=int_err)
goto 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) goto 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
@@ -548,34 +683,34 @@ contains
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)
goto 9999
endif
call d_coo_csmm_impl(alpha,a,x,beta,y,info,trans)
if (info /= 0) goto 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
@@ -591,30 +726,30 @@ contains
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) goto 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
@@ -631,15 +766,15 @@ contains
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)
goto 9999
endif
if (.not. (a%is_triangle())) then
write(0,*) 'Called SM on a non-triangular mat!'
@@ -649,25 +784,25 @@ contains
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
@@ -684,15 +819,15 @@ contains
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)
goto 9999
endif
if (.not. (a%is_triangle())) then
write(0,*) 'Called SM on a non-triangular mat!'
@@ -704,24 +839,24 @@ contains
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
subroutine d_coo_free(a)
class(psbn_d_coo_sparse_mat), intent(inout) :: a
if (allocated(a%ia)) deallocate(a%ia)
if (allocated(a%ja)) deallocate(a%ja)
if (allocated(a%val)) deallocate(a%val)
@@ -730,9 +865,9 @@ contains
call a%set_ncols(0)
return
end subroutine d_coo_free
subroutine d_coo_allocate_mnnz(m,n,nz,a)
use psb_error_mod
use psb_realloc_mod
@@ -741,7 +876,7 @@ contains
Integer :: err_act, info
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
if (m < 0) then
@@ -759,7 +894,7 @@ contains
call psb_errpush(info,name,i_err=(/3,0,0,0,0/))
goto 9999
endif
if (info == 0) call psb_realloc(nz,a%ia,info)
if (info == 0) call psb_realloc(nz,a%ja,info)
if (info == 0) call psb_realloc(nz,a%val,info)
@@ -770,22 +905,22 @@ contains
call a%set_bld()
call a%set_triangle(.false.)
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_allocate_mnnz
subroutine d_coo_allocate_mn(m,n,a)
use psb_error_mod
use psb_realloc_mod
@@ -794,7 +929,7 @@ contains
Integer :: err_act, info, nz
character(len=20) :: name='allocate_mn'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = 0
if (m < 0) then
@@ -807,25 +942,25 @@ contains
call psb_errpush(info,name,i_err=(/2,0,0,0,0/))
goto 9999
endif
nz = max(7*m,7*n,1)
call a%allocate(m,n,nz)
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_allocate_mn
end module psbn_d_base_mat_mod
base/newserial/psbn_d_coo_impl.f03
+72
View File
@@ -1615,6 +1615,78 @@ subroutine d_coo_from_coo_impl(a,b,info)
end subroutine d_coo_from_coo_impl
subroutine d_coo_to_fmt_impl(a,b,info)
use psb_error_mod
use psb_realloc_mod
use psbn_d_base_mat_mod, psb_protect_name => d_coo_to_fmt_impl
class(psbn_d_coo_sparse_mat), intent(in) :: a
class(psbn_d_base_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 b%from_coo(a,info)
if (info /= 0) goto 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_fmt_impl
subroutine d_coo_from_fmt_impl(a,b,info)
use psb_error_mod
use psb_realloc_mod
use psbn_d_base_mat_mod, psb_protect_name => d_coo_from_fmt_impl
class(psbn_d_coo_sparse_mat), intent(inout) :: a
class(psbn_d_base_sparse_mat), intent(in) :: b
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
integer :: m,n,nz
call psb_erractionsave(err_act)
info = 0
call b%to_coo(a,info)
if (info /= 0) goto 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_fmt_impl
subroutine d_fix_coo_impl(a,info,idir)
use psb_const_mod
use psb_error_mod
base/newserial/psbn_mat_mod.f03
+24
View File
@@ -49,6 +49,30 @@ module psbn_d_mat_mod
& is_unit, get_neigh, allocate_mn, allocate_mnnz, &
& reallocate_nz, free, d_csmv, d_csmm, d_cssv, d_cssm
interface psbn_spcnv
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 get_dupl(a) result(res)