mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 20:32:12 +00:00
psblas3:
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.
This commit is contained in:
Salvatore Filippone
@@ -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
|
||||
|
||||
@@ -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
|
||||
!
|
||||
|
||||
@@ -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(:)
|
||||
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%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
|
||||
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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
!
|
||||
|
||||
@@ -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(:)
|
||||
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%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
|
||||
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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
!
|
||||
|
||||
@@ -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(:)
|
||||
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%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
|
||||
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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
!
|
||||
|
||||
@@ -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(:)
|
||||
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%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
|
||||
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
|
||||
|
||||
@@ -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_)
|
||||
|
||||
@@ -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_)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user