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

psblas3:

Browse Source 
base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_vect_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_vect_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_vect_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_vect_mod.f90
 test/pargen/ppde.f90
 test/pargen/spde.f90
 util/psb_c_renum_impl.F90
 util/psb_d_renum_impl.F90
 util/psb_s_renum_impl.F90
 util/psb_z_renum_impl.F90

Vector fixes: add sync() to get_vect method, do away with assignment. 
Added AMD to renum_impl.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent dcdfd06d14
commit e5990ba918
18 changed files with 148 additions and 150 deletions
Show Stats Download Patch File Download Diff File

4
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ module psb_c_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_c_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput => psb_c_base_csput
procedure, pass(a) :: c_csgetrow => psb_c_base_csgetrow
@ -212,7 +212,7 @@ module psb_c_base_mat_mod
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! is more like queueing coefficients for later processing;
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag

25
base/modules/psb_c_base_vect_mod.f90
Unescape Escape View File

@ -82,12 +82,10 @@ module psb_c_base_vect_mod
! Set/get data from/to an external array; also
! overload assignment.
!
procedure, pass(x) :: getCopy => c_base_getCopy
procedure, pass(x) :: cpy_vect => c_base_cpy_vect
procedure, pass(x) :: get_vect => c_base_get_vect
procedure, pass(x) :: set_scal => c_base_set_scal
procedure, pass(x) :: set_vect => c_base_set_vect
generic, public :: set => set_vect, set_scal
generic, public :: assignment(=) => cpy_vect, set_scal
!
! Dot product and AXPBY
@ -354,28 +352,21 @@ contains
! overload the assignment.
!
function c_base_getCopy(x) result(res)
class(psb_c_base_vect_type), intent(in) :: x
complex(psb_spk_), allocatable :: res(:)
function c_base_get_vect(x) result(res)
class(psb_c_base_vect_type), intent(inout) :: x
complex(psb_spk_), allocatable :: res(:)
integer :: info
if (.not.allocated(x%v)) return
call x%sync()
allocate(res(x%get_nrows()),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy')
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
end function c_base_getCopy
end function c_base_get_vect
subroutine c_base_cpy_vect(res,x)
complex(psb_spk_), allocatable, intent(out) :: res(:)
class(psb_c_base_vect_type), intent(in) :: x
integer :: info
res = x%v
end subroutine c_base_cpy_vect
!
! Reset all values
!

26
base/modules/psb_c_vect_mod.f90
Unescape Escape View File

@ -78,9 +78,7 @@ module psb_c_vect_mod
procedure, pass(x) :: bld_x => c_vect_bld_x
procedure, pass(x) :: bld_n => c_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: getCopy => c_vect_getCopy
procedure, pass(x) :: cpy_vect => c_vect_cpy_vect
generic, public :: assignment(=) => cpy_vect
procedure, pass(x) :: get_vect => c_vect_get_vect
procedure, pass(x) :: cnv => c_vect_cnv
procedure, pass(x) :: set_scal => c_vect_set_scal
procedure, pass(x) :: set_vect => c_vect_set_vect
@ -127,23 +125,15 @@ contains
end subroutine c_vect_bld_n
function c_vect_getCopy(x) result(res)
class(psb_c_vect_type), intent(in) :: x
complex(psb_spk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v%getCopy()
end function c_vect_getCopy
subroutine c_vect_cpy_vect(res,x)
complex(psb_spk_), allocatable, intent(out) :: res(:)
class(psb_c_vect_type), intent(in) :: x
function c_vect_get_vect(x) result(res)
class(psb_c_vect_type), intent(inout) :: x
complex(psb_spk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v
end subroutine c_vect_cpy_vect
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function c_vect_get_vect
subroutine c_vect_set_scal(x,val)
class(psb_c_vect_type), intent(inout) :: x

4
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ module psb_d_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_d_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput => psb_d_base_csput
procedure, pass(a) :: d_csgetrow => psb_d_base_csgetrow
@ -212,7 +212,7 @@ module psb_d_base_mat_mod
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! is more like queueing coefficients for later processing;
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag

25
base/modules/psb_d_base_vect_mod.f90
Unescape Escape View File

@ -82,12 +82,10 @@ module psb_d_base_vect_mod
! Set/get data from/to an external array; also
! overload assignment.
!
procedure, pass(x) :: getCopy => d_base_getCopy
procedure, pass(x) :: cpy_vect => d_base_cpy_vect
procedure, pass(x) :: get_vect => d_base_get_vect
procedure, pass(x) :: set_scal => d_base_set_scal
procedure, pass(x) :: set_vect => d_base_set_vect
generic, public :: set => set_vect, set_scal
generic, public :: assignment(=) => cpy_vect, set_scal
!
! Dot product and AXPBY
@ -354,28 +352,21 @@ contains
! overload the assignment.
!
function d_base_getCopy(x) result(res)
class(psb_d_base_vect_type), intent(in) :: x
real(psb_dpk_), allocatable :: res(:)
function d_base_get_vect(x) result(res)
class(psb_d_base_vect_type), intent(inout) :: x
real(psb_dpk_), allocatable :: res(:)
integer :: info
if (.not.allocated(x%v)) return
call x%sync()
allocate(res(x%get_nrows()),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy')
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
end function d_base_getCopy
end function d_base_get_vect
subroutine d_base_cpy_vect(res,x)
real(psb_dpk_), allocatable, intent(out) :: res(:)
class(psb_d_base_vect_type), intent(in) :: x
integer :: info
res = x%v
end subroutine d_base_cpy_vect
!
! Reset all values
!

26
base/modules/psb_d_vect_mod.f90
Unescape Escape View File

@ -78,9 +78,7 @@ module psb_d_vect_mod
procedure, pass(x) :: bld_x => d_vect_bld_x
procedure, pass(x) :: bld_n => d_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: getCopy => d_vect_getCopy
procedure, pass(x) :: cpy_vect => d_vect_cpy_vect
generic, public :: assignment(=) => cpy_vect
procedure, pass(x) :: get_vect => d_vect_get_vect
procedure, pass(x) :: cnv => d_vect_cnv
procedure, pass(x) :: set_scal => d_vect_set_scal
procedure, pass(x) :: set_vect => d_vect_set_vect
@ -127,23 +125,15 @@ contains
end subroutine d_vect_bld_n
function d_vect_getCopy(x) result(res)
class(psb_d_vect_type), intent(in) :: x
real(psb_dpk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v%getCopy()
end function d_vect_getCopy
subroutine d_vect_cpy_vect(res,x)
real(psb_dpk_), allocatable, intent(out) :: res(:)
class(psb_d_vect_type), intent(in) :: x
function d_vect_get_vect(x) result(res)
class(psb_d_vect_type), intent(inout) :: x
real(psb_dpk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v
end subroutine d_vect_cpy_vect
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function d_vect_get_vect
subroutine d_vect_set_scal(x,val)
class(psb_d_vect_type), intent(inout) :: x

4
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ module psb_s_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_s_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput => psb_s_base_csput
procedure, pass(a) :: s_csgetrow => psb_s_base_csgetrow
@ -212,7 +212,7 @@ module psb_s_base_mat_mod
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! is more like queueing coefficients for later processing;
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag

25
base/modules/psb_s_base_vect_mod.f90
Unescape Escape View File

@ -82,12 +82,10 @@ module psb_s_base_vect_mod
! Set/get data from/to an external array; also
! overload assignment.
!
procedure, pass(x) :: getCopy => s_base_getCopy
procedure, pass(x) :: cpy_vect => s_base_cpy_vect
procedure, pass(x) :: get_vect => s_base_get_vect
procedure, pass(x) :: set_scal => s_base_set_scal
procedure, pass(x) :: set_vect => s_base_set_vect
generic, public :: set => set_vect, set_scal
generic, public :: assignment(=) => cpy_vect, set_scal
!
! Dot product and AXPBY
@ -354,28 +352,21 @@ contains
! overload the assignment.
!
function s_base_getCopy(x) result(res)
class(psb_s_base_vect_type), intent(in) :: x
real(psb_spk_), allocatable :: res(:)
function s_base_get_vect(x) result(res)
class(psb_s_base_vect_type), intent(inout) :: x
real(psb_spk_), allocatable :: res(:)
integer :: info
if (.not.allocated(x%v)) return
call x%sync()
allocate(res(x%get_nrows()),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy')
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
end function s_base_getCopy
end function s_base_get_vect
subroutine s_base_cpy_vect(res,x)
real(psb_spk_), allocatable, intent(out) :: res(:)
class(psb_s_base_vect_type), intent(in) :: x
integer :: info
res = x%v
end subroutine s_base_cpy_vect
!
! Reset all values
!

26
base/modules/psb_s_vect_mod.f90
Unescape Escape View File

@ -78,9 +78,7 @@ module psb_s_vect_mod
procedure, pass(x) :: bld_x => s_vect_bld_x
procedure, pass(x) :: bld_n => s_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: getCopy => s_vect_getCopy
procedure, pass(x) :: cpy_vect => s_vect_cpy_vect
generic, public :: assignment(=) => cpy_vect
procedure, pass(x) :: get_vect => s_vect_get_vect
procedure, pass(x) :: cnv => s_vect_cnv
procedure, pass(x) :: set_scal => s_vect_set_scal
procedure, pass(x) :: set_vect => s_vect_set_vect
@ -127,23 +125,15 @@ contains
end subroutine s_vect_bld_n
function s_vect_getCopy(x) result(res)
class(psb_s_vect_type), intent(in) :: x
real(psb_spk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v%getCopy()
end function s_vect_getCopy
subroutine s_vect_cpy_vect(res,x)
real(psb_spk_), allocatable, intent(out) :: res(:)
class(psb_s_vect_type), intent(in) :: x
function s_vect_get_vect(x) result(res)
class(psb_s_vect_type), intent(inout) :: x
real(psb_spk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v
end subroutine s_vect_cpy_vect
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function s_vect_get_vect
subroutine s_vect_set_scal(x,val)
class(psb_s_vect_type), intent(inout) :: x

4
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -61,7 +61,7 @@ module psb_z_base_mat_mod
type, extends(psb_base_sparse_mat) :: psb_z_base_sparse_mat
contains
!
! Data management methods: defined here, but not implemented.
! Data management methods: defined here, but (mostly) not implemented.
!
procedure, pass(a) :: csput => psb_z_base_csput
procedure, pass(a) :: z_csgetrow => psb_z_base_csgetrow
@ -212,7 +212,7 @@ module psb_z_base_mat_mod
! Catches:
! 1. If A is in the BUILD state, then this method
! can only be called for COO matrice, in which case it
! is more like queueing coefficients for later processing.
! is more like queueing coefficients for later processing;
! 2. If A is in the UPDATE state, then every derived class must
! implement this;
! 3. In the UPDATE state, depending on the value of DUPL flag

25
base/modules/psb_z_base_vect_mod.f90
Unescape Escape View File

@ -82,12 +82,10 @@ module psb_z_base_vect_mod
! Set/get data from/to an external array; also
! overload assignment.
!
procedure, pass(x) :: getCopy => z_base_getCopy
procedure, pass(x) :: cpy_vect => z_base_cpy_vect
procedure, pass(x) :: get_vect => z_base_get_vect
procedure, pass(x) :: set_scal => z_base_set_scal
procedure, pass(x) :: set_vect => z_base_set_vect
generic, public :: set => set_vect, set_scal
generic, public :: assignment(=) => cpy_vect, set_scal
!
! Dot product and AXPBY
@ -354,28 +352,21 @@ contains
! overload the assignment.
!
function z_base_getCopy(x) result(res)
class(psb_z_base_vect_type), intent(in) :: x
complex(psb_dpk_), allocatable :: res(:)
function z_base_get_vect(x) result(res)
class(psb_z_base_vect_type), intent(inout) :: x
complex(psb_dpk_), allocatable :: res(:)
integer :: info
if (.not.allocated(x%v)) return
call x%sync()
allocate(res(x%get_nrows()),stat=info)
if (info /= 0) then
call psb_errpush(psb_err_alloc_dealloc_,'base_getCopy')
call psb_errpush(psb_err_alloc_dealloc_,'base_get_vect')
return
end if
res(:) = x%v(:)
end function z_base_getCopy
end function z_base_get_vect
subroutine z_base_cpy_vect(res,x)
complex(psb_dpk_), allocatable, intent(out) :: res(:)
class(psb_z_base_vect_type), intent(in) :: x
integer :: info
res = x%v
end subroutine z_base_cpy_vect
!
! Reset all values
!

26
base/modules/psb_z_vect_mod.f90
Unescape Escape View File

@ -78,9 +78,7 @@ module psb_z_vect_mod
procedure, pass(x) :: bld_x => z_vect_bld_x
procedure, pass(x) :: bld_n => z_vect_bld_n
generic, public :: bld => bld_x, bld_n
procedure, pass(x) :: getCopy => z_vect_getCopy
procedure, pass(x) :: cpy_vect => z_vect_cpy_vect
generic, public :: assignment(=) => cpy_vect
procedure, pass(x) :: get_vect => z_vect_get_vect
procedure, pass(x) :: cnv => z_vect_cnv
procedure, pass(x) :: set_scal => z_vect_set_scal
procedure, pass(x) :: set_vect => z_vect_set_vect
@ -127,23 +125,15 @@ contains
end subroutine z_vect_bld_n
function z_vect_getCopy(x) result(res)
class(psb_z_vect_type), intent(in) :: x
complex(psb_dpk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v%getCopy()
end function z_vect_getCopy
subroutine z_vect_cpy_vect(res,x)
complex(psb_dpk_), allocatable, intent(out) :: res(:)
class(psb_z_vect_type), intent(in) :: x
function z_vect_get_vect(x) result(res)
class(psb_z_vect_type), intent(inout) :: x
complex(psb_dpk_), allocatable :: res(:)
integer :: info
if (allocated(x%v)) res = x%v
end subroutine z_vect_cpy_vect
if (allocated(x%v)) then
res = x%v%get_vect()
end if
end function z_vect_get_vect
subroutine z_vect_set_scal(x,val)
class(psb_z_vect_type), intent(inout) :: x

2
test/pargen/ppde.f90
Unescape Escape View File

@ -222,7 +222,7 @@ program ppde
call psb_geall(vtst,desc_b, info)
vtst%v%v = iam+1
call psb_geasb(vtst,desc_b,info)
tst = vtst
tst = vtst%get_vect()
call psb_geasb(tst,desc_b,info)
call psb_ovrl(vtst,desc_b,info,update=psb_avg_)
call psb_ovrl(tst,desc_b,info,update=psb_avg_)

2
test/pargen/spde.f90
Unescape Escape View File

@ -222,7 +222,7 @@ program ppde
call psb_geall(vtst,desc_b, info)
vtst%v%v = iam+1
call psb_geasb(vtst,desc_b,info)
tst = vtst
tst = vtst%get_vect()
call psb_geasb(tst,desc_b,info)
call psb_ovrl(vtst,desc_b,info,update=psb_avg_)
call psb_ovrl(tst,desc_b,info,update=psb_avg_)

18
util/psb_c_renum_impl.F90
Unescape Escape View File

@ -24,6 +24,23 @@ subroutine psb_c_mat_renums(alg,mat,info,perm)
ialg = -1
end select
call psb_mat_renum(ialg,mat,info,perm)
if (info /= psb_success_) then
info = psb_err_from_subroutine_non_
call psb_errpush(info,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 psb_c_mat_renums
subroutine psb_c_mat_renum(alg,mat,info,perm)
@ -206,6 +223,7 @@ contains
class(psb_c_base_sparse_mat), allocatable :: aa
type(psb_c_coo_sparse_mat) :: acoo
integer, allocatable :: perm(:)
integer :: err_act
character(len=20) :: name
integer :: i, j, k, ideg, nr, ibw, ipf, idpth, nz

20
util/psb_d_renum_impl.F90
Unescape Escape View File

@ -21,9 +21,28 @@ subroutine psb_d_mat_renums(alg,mat,info,perm)
case ('AMD')
ialg = psb_mat_renum_amd_
case default
write(0,*) 'Unknown algorithm "',psb_toupper(alg),'"'
ialg = -1
end select
call psb_mat_renum(ialg,mat,info,perm)
if (info /= psb_success_) then
info = psb_err_from_subroutine_non_
call psb_errpush(info,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 psb_d_mat_renums
subroutine psb_d_mat_renum(alg,mat,info,perm)
@ -206,6 +225,7 @@ contains
class(psb_d_base_sparse_mat), allocatable :: aa
type(psb_d_coo_sparse_mat) :: acoo
integer, allocatable :: perm(:)
integer :: err_act
character(len=20) :: name
integer :: i, j, k, ideg, nr, ibw, ipf, idpth, nz

18
util/psb_s_renum_impl.F90
Unescape Escape View File

@ -24,6 +24,23 @@ subroutine psb_s_mat_renums(alg,mat,info,perm)
ialg = -1
end select
call psb_mat_renum(ialg,mat,info,perm)
if (info /= psb_success_) then
info = psb_err_from_subroutine_non_
call psb_errpush(info,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 psb_s_mat_renums
subroutine psb_s_mat_renum(alg,mat,info,perm)
@ -206,6 +223,7 @@ contains
class(psb_s_base_sparse_mat), allocatable :: aa
type(psb_s_coo_sparse_mat) :: acoo
integer, allocatable :: perm(:)
integer :: err_act
character(len=20) :: name
integer :: i, j, k, ideg, nr, ibw, ipf, idpth, nz

18
util/psb_z_renum_impl.F90
Unescape Escape View File

@ -24,6 +24,23 @@ subroutine psb_z_mat_renums(alg,mat,info,perm)
ialg = -1
end select
call psb_mat_renum(ialg,mat,info,perm)
if (info /= psb_success_) then
info = psb_err_from_subroutine_non_
call psb_errpush(info,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 psb_z_mat_renums
subroutine psb_z_mat_renum(alg,mat,info,perm)
@ -206,6 +223,7 @@ contains
class(psb_z_base_sparse_mat), allocatable :: aa
type(psb_z_coo_sparse_mat) :: acoo
integer, allocatable :: perm(:)
integer :: err_act
character(len=20) :: name
integer :: i, j, k, ideg, nr, ibw, ipf, idpth, nz

Write Preview
Loading…
Cancel
Save