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

psblas3-submodules:

Browse Source 
base/internals/psi_dswapdata.F90
 base/internals/psi_dswaptran.F90
 base/internals/psi_ovrl_restr.f90
 base/internals/psi_ovrl_save.f90
 base/internals/psi_ovrl_upd.f90
 base/modules/psb_base_mat_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_d_csc_mat_mod.f90
 base/modules/psb_d_csr_mat_mod.f90
 base/modules/psb_d_mat_mod.f90
 base/modules/psb_d_sort_mod.f90
 base/modules/psb_error_impl.F90
 base/modules/psb_error_mod.F90
 base/modules/psi_d_mod.f90
 base/modules/psi_serial_mod.f90
 base/serial/impl/psb_base_mat_impl.f90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90
 base/serial/impl/psb_d_mat_impl.F90
 base/serial/psi_serial_impl.f90
 base/serial/sort/psb_d_hsort_impl.f90
 base/serial/sort/psb_d_isort_impl.f90
 base/serial/sort/psb_d_msort_impl.f90
 base/serial/sort/psb_d_qsort_impl.f90
 prec/impl/psb_dilu_fct.f90
 test/pargen/runs/ppde.inp
 util/psb_d_renum_impl.F90
 util/psb_metispart_mod.F90

Encapsulated in submodules many of the D impl files.
Made CSR data components PRIVATE and adjusted prec/util accordingly
(defined special accessor functions).
psblas3-submodules
Salvatore Filippone 10 years ago
parent 8b994d012f
commit f63f52e21b
30 changed files with 15952 additions and 16047 deletions
Show Stats Download Patch File Download Diff File

2233
base/internals/psi_dswapdata.F90
View File

File diff suppressed because it is too large Load Diff

2253
base/internals/psi_dswaptran.F90
View File

File diff suppressed because it is too large Load Diff

220
base/internals/psi_ovrl_restr.f90
Unescape Escape View File

@ -118,97 +118,144 @@ subroutine psi_sovrl_restrr2(x,xs,desc_a,info)
return
end subroutine psi_sovrl_restrr2
submodule (psi_d_mod) psi_dovrl_restore_mod
contains
subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
call psb_erractionrestore(err_act)
return
subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_restrr1
9999 call psb_error_handler(ictxt,err_act)
implicit none
return
end subroutine psi_dovrl_restrr1
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
name='psi_dovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
isz = size(desc_a%ovrlap_elem,1)
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx) = xs(i)
end do
name='psi_dovrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
call psb_erractionrestore(err_act)
return
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_restrr1
isz = size(desc_a%ovrlap_elem,1)
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_restrr2
call psb_erractionrestore(err_act)
return
implicit none
9999 call psb_error_handler(ictxt,err_act)
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
return
end subroutine psi_dovrl_restrr2
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_d_base_vect_mod
name='psi_dovrl_restrr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
implicit none
if (size(x,2) /= size(xs,2)) then
info = psb_err_internal_error_
call psb_errpush(info,name, a_err='Mismacth columns X vs XS')
goto 9999
endif
class(psb_d_base_vect_type) :: x
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
isz = size(desc_a%ovrlap_elem,1)
name='psi_dovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
x(idx,:) = xs(i,:)
end do
isz = size(desc_a%ovrlap_elem,1)
call psb_erractionrestore(err_act)
return
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,dzero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_restrr2
return
end subroutine psi_dovrl_restr_vect
end submodule psi_dovrl_restore_mod
subroutine psi_covrl_restrr1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_restrr1
@ -561,47 +608,6 @@ subroutine psi_sovrl_restr_vect(x,xs,desc_a,info)
end subroutine psi_sovrl_restr_vect
subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_restr_vect
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_restrr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call x%sct(isz,desc_a%ovrlap_elem(:,1),xs,dzero)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_restr_vect
subroutine psi_covrl_restr_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_restr_vect

281
base/internals/psi_ovrl_save.f90
Unescape Escape View File

@ -127,104 +127,160 @@ subroutine psi_sovrl_saver2(x,xs,desc_a,info)
return
end subroutine psi_sovrl_saver2
subroutine psi_dovrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_saver1
use psb_realloc_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
submodule (psi_d_mod) psi_dovrl_save_mod
contains
subroutine psi_dovrl_saver1(x,xs,desc_a,info)
use psb_penv_mod
use psb_realloc_mod
use psb_const_mod
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i) = x(idx)
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_saver1
subroutine psi_dovrl_saver2(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_saver2
use psb_realloc_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_dovrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
return
end subroutine psi_dovrl_saver1
subroutine psi_dovrl_saver2(x,xs,desc_a,info)
use psb_penv_mod
use psb_const_mod
use psb_error_mod
use psb_realloc_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz, nc
character(len=20) :: name, ch_err
name='psi_dovrl_saver2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
nc = size(x,2)
call psb_realloc(isz,nc,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
call psb_erractionrestore(err_act)
return
do i=1, isz
idx = desc_a%ovrlap_elem(i,1)
xs(i,:) = x(idx,:)
end do
9999 call psb_error_handler(ictxt,err_act)
call psb_erractionrestore(err_act)
return
return
end subroutine psi_dovrl_saver2
subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
use psb_penv_mod
use psb_const_mod
use psb_error_mod
use psb_realloc_mod
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_saver2
return
end subroutine psi_dovrl_save_vect
end submodule psi_dovrl_save_mod
subroutine psi_covrl_saver1(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_saver1
@ -621,51 +677,6 @@ subroutine psi_sovrl_save_vect(x,xs,desc_a,info)
return
end subroutine psi_sovrl_save_vect
subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_dovrl_save_vect
use psb_realloc_mod
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, isz
character(len=20) :: name, ch_err
name='psi_dovrl_saver1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
isz = size(desc_a%ovrlap_elem,1)
call psb_realloc(isz,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
call x%gth(isz,desc_a%ovrlap_elem(:,1),xs)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_save_vect
subroutine psi_covrl_save_vect(x,xs,desc_a,info)
use psi_mod, psi_protect_name => psi_covrl_save_vect

409
base/internals/psi_ovrl_upd.f90
Unescape Escape View File

@ -163,138 +163,233 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info)
return
end subroutine psi_sovrl_updr2
subroutine psi_dovrl_updr1(x,desc_a,update,info)
use psi_mod, psi_protect_name => psi_dovrl_updr1
implicit none
real(psb_dpk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
submodule (psi_d_mod) psi_dovrl_upd_mod
contains
subroutine psi_dovrl_updr1(x,desc_a,update,info)
use psb_penv_mod
use psb_const_mod
use psb_desc_const_mod
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
! switch on update type
select case (update)
case(psb_square_root_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/sqrt(real(ndm))
end do
case(psb_avg_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx) = dzero
end do
case(psb_sum_)
! do nothing
! switch on update type
select case (update)
case(psb_square_root_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/sqrt(real(ndm))
end do
case(psb_avg_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx) = dzero
end do
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call psb_erractionrestore(err_act)
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_updr1
subroutine psi_dovrl_updr2(x,desc_a,update,info)
use psi_mod, psi_protect_name => psi_dovrl_updr2
return
end subroutine psi_dovrl_updr1
subroutine psi_dovrl_updr2(x,desc_a,update,info)
use psb_penv_mod
use psb_const_mod
use psb_desc_const_mod
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
implicit none
! switch on update type
select case (update)
case(psb_square_root_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/sqrt(real(ndm))
end do
case(psb_avg_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx,:) = dzero
end do
case(psb_sum_)
! do nothing
real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
! locals
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
call psb_erractionrestore(err_act)
return
name='psi_dovrl_updr2'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
9999 call psb_error_handler(ictxt,err_act)
! switch on update type
select case (update)
case(psb_square_root_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/sqrt(real(ndm))
end do
case(psb_avg_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx,:) = dzero
end do
case(psb_sum_)
! do nothing
return
end subroutine psi_dovrl_updr2
subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
use psb_penv_mod
use psb_const_mod
use psb_desc_const_mod
use psb_error_mod
use psb_realloc_mod
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
! locals
real(psb_dpk_), allocatable :: xs(:)
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
nx = size(desc_a%ovrlap_elem,1)
call psb_realloc(nx,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_Dealloc_
call psb_errpush(info,name)
goto 9999
end if
if (update /= psb_sum_) then
call x%gth(nx,desc_a%ovrlap_elem(:,1),xs)
! switch on update type
select case (update)
case(psb_square_root_)
do i=1,nx
ndm = desc_a%ovrlap_elem(i,2)
xs(i) = xs(i)/sqrt(dble(ndm))
end do
case(psb_avg_)
do i=1,nx
ndm = desc_a%ovrlap_elem(i,2)
xs(i) = xs(i)/dble(ndm)
end do
case(psb_setzero_)
do i=1,nx
if (me /= desc_a%ovrlap_elem(i,3))&
& xs(i) = dzero
end do
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,dzero)
end if
call psb_erractionrestore(err_act)
return
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
9999 call psb_error_handler(ictxt,err_act)
call psb_erractionrestore(err_act)
return
return
end subroutine psi_dovrl_upd_vect
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_updr2
end submodule psi_dovrl_upd_mod
subroutine psi_covrl_updr1(x,desc_a,update,info)
use psi_mod, psi_protect_name => psi_covrl_updr1
@ -856,86 +951,6 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info)
return
end subroutine psi_sovrl_upd_vect
subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
use psi_mod, psi_protect_name => psi_dovrl_upd_vect
use psb_realloc_mod
use psb_d_base_vect_mod
implicit none
class(psb_d_base_vect_type) :: x
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
! locals
real(psb_dpk_), allocatable :: xs(:)
integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name, ch_err
name='psi_dovrl_updr1'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
ictxt = desc_a%get_context()
call psb_info(ictxt, me, np)
if (np == -1) then
info = psb_err_context_error_
call psb_errpush(info,name)
goto 9999
endif
nx = size(desc_a%ovrlap_elem,1)
call psb_realloc(nx,xs,info)
if (info /= psb_success_) then
info = psb_err_alloc_Dealloc_
call psb_errpush(info,name)
goto 9999
end if
if (update /= psb_sum_) then
call x%gth(nx,desc_a%ovrlap_elem(:,1),xs)
! switch on update type
select case (update)
case(psb_square_root_)
do i=1,nx
ndm = desc_a%ovrlap_elem(i,2)
xs(i) = xs(i)/sqrt(dble(ndm))
end do
case(psb_avg_)
do i=1,nx
ndm = desc_a%ovrlap_elem(i,2)
xs(i) = xs(i)/dble(ndm)
end do
case(psb_setzero_)
do i=1,nx
if (me /= desc_a%ovrlap_elem(i,3))&
& xs(i) = dzero
end do
case(psb_sum_)
! do nothing
case default
! wrong value for choice argument
info = psb_err_iarg_invalid_value_
ierr(1) = 3; ierr(2)=update;
call psb_errpush(info,name,i_err=ierr)
goto 9999
end select
call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,dzero)
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(ictxt,err_act)
return
end subroutine psi_dovrl_upd_vect
subroutine psi_covrl_upd_vect(x,desc_a,update,info)
use psi_mod, psi_protect_name => psi_covrl_upd_vect
use psb_realloc_mod

22
base/modules/psb_base_mat_mod.f90
Unescape Escape View File

@ -229,7 +229,7 @@ module psb_base_mat_mod
!! \param idx The line we are interested in.
!
interface
function psb_base_get_nz_row(idx,a) result(res)
module function psb_base_get_nz_row(idx,a) result(res)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
integer(psb_ipk_), intent(in) :: idx
class(psb_base_sparse_mat), intent(in) :: a
@ -244,7 +244,7 @@ module psb_base_mat_mod
!! count(A(:,:)/=0)
!
interface
function psb_base_get_nzeros(a) result(res)
module function psb_base_get_nzeros(a) result(res)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
@ -259,7 +259,7 @@ module psb_base_mat_mod
!! currently occupied)
!
interface
function psb_base_get_size(a) result(res)
module function psb_base_get_size(a) result(res)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
@ -272,7 +272,7 @@ module psb_base_mat_mod
!! \param clear [true] explicitly zero out coefficients.
!
interface
subroutine psb_base_reinit(a,clear)
module subroutine psb_base_reinit(a,clear)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
@ -291,7 +291,7 @@ module psb_base_mat_mod
!! \param ivc(:) [none] renumbering for the cols
!
interface
subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc)
module subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
integer(psb_ipk_), intent(in) :: iout
class(psb_base_sparse_mat), intent(in) :: a
@ -330,7 +330,7 @@ module psb_base_mat_mod
!
interface
subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
module subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(in) :: a
@ -361,7 +361,7 @@ module psb_base_mat_mod
!! i.e. when lev=2 find neighours of neighbours, etc.
!
interface
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
module subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: idx
@ -383,7 +383,7 @@ module psb_base_mat_mod
!! \param nz [estimated internally] number of nonzeros to allocate for
!
interface
subroutine psb_base_allocate_mnnz(m,n,a,nz)
module subroutine psb_base_allocate_mnnz(m,n,a,nz)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
integer(psb_ipk_), intent(in) :: m,n
class(psb_base_sparse_mat), intent(inout) :: a
@ -401,7 +401,7 @@ module psb_base_mat_mod
!! \param nz number of nonzeros to allocate for
!
interface
subroutine psb_base_reallocate_nz(nz,a)
module subroutine psb_base_reallocate_nz(nz,a)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
integer(psb_ipk_), intent(in) :: nz
class(psb_base_sparse_mat), intent(inout) :: a
@ -414,7 +414,7 @@ module psb_base_mat_mod
!! \brief destructor
!
interface
subroutine psb_base_free(a)
module subroutine psb_base_free(a)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(inout) :: a
end subroutine psb_base_free
@ -428,7 +428,7 @@ module psb_base_mat_mod
!! possible given the actual number of nonzeros it contains.
!
interface
subroutine psb_base_trim(a)
module subroutine psb_base_trim(a)
import :: psb_ipk_, psb_long_int_k_, psb_base_sparse_mat
class(psb_base_sparse_mat), intent(inout) :: a
end subroutine psb_base_trim

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

@ -257,7 +257,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
module subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -268,7 +268,7 @@ module psb_d_base_mat_mod
end interface
interface
subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
module subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type,&
& psb_i_base_vect_type
class(psb_d_base_sparse_mat), intent(inout) :: a
@ -313,7 +313,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
module subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
@ -352,7 +352,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
module subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
@ -390,7 +390,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csclip(a,b,info,&
module subroutine psb_d_base_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
@ -430,7 +430,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_tril(a,b,info,diag,imin,imax,&
module subroutine psb_d_base_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
@ -471,7 +471,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_triu(a,b,info,diag,imin,imax,&
module subroutine psb_d_base_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
@ -494,7 +494,7 @@ module psb_d_base_mat_mod
!! \param info return code.
!
interface
subroutine psb_d_base_get_diag(a,d,info)
module subroutine psb_d_base_get_diag(a,d,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -513,7 +513,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_mold(a,b,info)
module subroutine psb_d_base_mold(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_long_int_k_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
@ -535,7 +535,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_clone(a,b, info)
module subroutine psb_d_base_clone(a,b, info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_long_int_k_
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
@ -554,7 +554,7 @@ module psb_d_base_mat_mod
!! This is needed e.g. when scaling
!
interface
subroutine psb_d_base_make_nonunit(a)
module subroutine psb_d_base_make_nonunit(a)
import :: psb_d_base_sparse_mat
implicit none
class(psb_d_base_sparse_mat), intent(inout) :: a
@ -571,7 +571,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_cp_to_coo(a,b,info)
module subroutine psb_d_base_cp_to_coo(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -588,7 +588,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_cp_from_coo(a,b,info)
module subroutine psb_d_base_cp_from_coo(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
@ -606,7 +606,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_cp_to_fmt(a,b,info)
module subroutine psb_d_base_cp_to_fmt(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -624,7 +624,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_cp_from_fmt(a,b,info)
module subroutine psb_d_base_cp_from_fmt(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
@ -641,7 +641,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_mv_to_coo(a,b,info)
module subroutine psb_d_base_mv_to_coo(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -658,7 +658,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_mv_from_coo(a,b,info)
module subroutine psb_d_base_mv_from_coo(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -676,7 +676,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_mv_to_fmt(a,b,info)
module subroutine psb_d_base_mv_to_fmt(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -694,7 +694,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_mv_from_fmt(a,b,info)
module subroutine psb_d_base_mv_from_fmt(a,b,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -711,7 +711,7 @@ module psb_d_base_mat_mod
!! \param b The output variable
!
interface
subroutine psb_d_base_transp_2mat(a,b)
module subroutine psb_d_base_transp_2mat(a,b)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
@ -727,7 +727,7 @@ module psb_d_base_mat_mod
!! \param b The output variable
!
interface
subroutine psb_d_base_transc_2mat(a,b)
module subroutine psb_d_base_transc_2mat(a,b)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
class(psb_base_sparse_mat), intent(out) :: b
@ -742,7 +742,7 @@ module psb_d_base_mat_mod
!! In-place version.
!
interface
subroutine psb_d_base_transp_1mat(a)
module subroutine psb_d_base_transp_1mat(a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_transp_1mat
@ -756,7 +756,7 @@ module psb_d_base_mat_mod
!! In-place version.
!
interface
subroutine psb_d_base_transc_1mat(a)
module subroutine psb_d_base_transc_1mat(a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
end subroutine psb_d_base_transc_1mat
@ -781,7 +781,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csmm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_base_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -809,7 +809,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_csmv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_base_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -844,7 +844,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_vect_mv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_base_vect_mv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
@ -876,7 +876,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -911,7 +911,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_inner_cssv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_base_inner_cssv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -946,7 +946,7 @@ module psb_d_base_mat_mod
!! or its conjugate transpose (C)
!
interface
subroutine psb_d_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_, psb_d_base_vect_type
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
@ -978,7 +978,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
module subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -1011,7 +1011,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
module subroutine psb_d_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -1045,7 +1045,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
module subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_,psb_d_base_vect_type
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta
@ -1065,7 +1065,7 @@ module psb_d_base_mat_mod
!! \param info return code
!
interface
subroutine psb_d_base_scals(d,a,info)
module subroutine psb_d_base_scals(d,a,info)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d
@ -1083,7 +1083,7 @@ module psb_d_base_mat_mod
!! \param side [L] Scale on the Left (rows) or on the Right (columns)
!
interface
subroutine psb_d_base_scal(d,a,info,side)
module subroutine psb_d_base_scal(d,a,info,side)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
@ -1099,7 +1099,7 @@ module psb_d_base_mat_mod
!!
!
interface
function psb_d_base_maxval(a) result(res)
module function psb_d_base_maxval(a) result(res)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -1114,7 +1114,7 @@ module psb_d_base_mat_mod
!!
!
interface
function psb_d_base_csnmi(a) result(res)
module function psb_d_base_csnmi(a) result(res)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -1129,7 +1129,7 @@ module psb_d_base_mat_mod
!!
!
interface
function psb_d_base_csnm1(a) result(res)
module function psb_d_base_csnm1(a) result(res)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -1145,8 +1145,8 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_rowsum(d,a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
module subroutine psb_d_base_rowsum(d,a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_d_base_rowsum
@ -1159,7 +1159,7 @@ module psb_d_base_mat_mod
!! \param d(:) The output row sums
!!
interface
subroutine psb_d_base_arwsum(d,a)
module subroutine psb_d_base_arwsum(d,a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1175,7 +1175,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_base_colsum(d,a)
module subroutine psb_d_base_colsum(d,a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1189,7 +1189,7 @@ module psb_d_base_mat_mod
!! \param d(:) The output col sums
!!
interface
subroutine psb_d_base_aclsum(d,a)
module subroutine psb_d_base_aclsum(d,a)
import :: psb_ipk_, psb_d_base_sparse_mat, psb_dpk_
class(psb_d_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1209,7 +1209,7 @@ module psb_d_base_mat_mod
!! \see psb_base_mat_mod::psb_base_reallocate_nz
!
interface
subroutine psb_d_coo_reallocate_nz(nz,a)
module subroutine psb_d_coo_reallocate_nz(nz,a)
import :: psb_ipk_, psb_d_coo_sparse_mat
integer(psb_ipk_), intent(in) :: nz
class(psb_d_coo_sparse_mat), intent(inout) :: a
@ -1222,7 +1222,7 @@ module psb_d_base_mat_mod
!! \see psb_base_mat_mod::psb_base_reinit
!
interface
subroutine psb_d_coo_reinit(a,clear)
module subroutine psb_d_coo_reinit(a,clear)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
@ -1234,7 +1234,7 @@ module psb_d_base_mat_mod
!! \see psb_base_mat_mod::psb_base_trim
!
interface
subroutine psb_d_coo_trim(a)
module subroutine psb_d_coo_trim(a)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
end subroutine psb_d_coo_trim
@ -1246,7 +1246,7 @@ module psb_d_base_mat_mod
!! \see psb_base_mat_mod::psb_base_allocate_mnnz
!
interface
subroutine psb_d_coo_allocate_mnnz(m,n,a,nz)
module subroutine psb_d_coo_allocate_mnnz(m,n,a,nz)
import :: psb_ipk_, psb_d_coo_sparse_mat
integer(psb_ipk_), intent(in) :: m,n
class(psb_d_coo_sparse_mat), intent(inout) :: a
@ -1258,7 +1258,7 @@ module psb_d_base_mat_mod
!> \memberof psb_d_coo_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_d_coo_mold(a,b,info)
module subroutine psb_d_coo_mold(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_
class(psb_d_coo_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
@ -1280,7 +1280,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc)
module subroutine psb_d_coo_print(iout,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_d_coo_sparse_mat
integer(psb_ipk_), intent(in) :: iout
class(psb_d_coo_sparse_mat), intent(in) :: a
@ -1301,7 +1301,7 @@ module psb_d_base_mat_mod
!!
!
interface
function psb_d_coo_get_nz_row(idx,a) result(res)
module function psb_d_coo_get_nz_row(idx,a) result(res)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: idx
@ -1311,7 +1311,7 @@ module psb_d_base_mat_mod
!
!> Funtion: fix_coo_inner
!> Function: fix_coo_inner
!! \brief Make sure the entries are sorted and duplicates are handled.
!! Used internally by fix_coo
!! \param nzin Number of entries on input to be handled
@ -1325,7 +1325,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
module subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
import :: psb_ipk_, psb_dpk_
integer(psb_ipk_), intent(in) :: nr,nc,nzin,dupl
integer(psb_ipk_), intent(inout) :: ia(:), ja(:)
@ -1344,7 +1344,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_fix_coo(a,info,idir)
module subroutine psb_d_fix_coo(a,info,idir)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(out) :: info
@ -1356,7 +1356,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_to_coo
interface
subroutine psb_d_cp_coo_to_coo(a,b,info)
module subroutine psb_d_cp_coo_to_coo(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -1368,7 +1368,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo
interface
subroutine psb_d_cp_coo_from_coo(a,b,info)
module subroutine psb_d_cp_coo_from_coo(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
@ -1381,7 +1381,7 @@ module psb_d_base_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo
!!
interface
subroutine psb_d_cp_coo_to_fmt(a,b,info)
module subroutine psb_d_cp_coo_to_fmt(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat
class(psb_d_coo_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -1394,7 +1394,7 @@ module psb_d_base_mat_mod
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_fmt
!!
interface
subroutine psb_d_cp_coo_from_fmt(a,b,info)
module subroutine psb_d_cp_coo_from_fmt(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
@ -1406,7 +1406,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_to_coo
interface
subroutine psb_d_mv_coo_to_coo(a,b,info)
module subroutine psb_d_mv_coo_to_coo(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -1418,7 +1418,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_from_coo
interface
subroutine psb_d_mv_coo_from_coo(a,b,info)
module subroutine psb_d_mv_coo_from_coo(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -1430,7 +1430,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_to_fmt
interface
subroutine psb_d_mv_coo_to_fmt(a,b,info)
module subroutine psb_d_mv_coo_to_fmt(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -1442,7 +1442,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_from_fmt
interface
subroutine psb_d_mv_coo_from_fmt(a,b,info)
module subroutine psb_d_mv_coo_from_fmt(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_base_sparse_mat
class(psb_d_coo_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -1451,7 +1451,7 @@ module psb_d_base_mat_mod
end interface
interface
subroutine psb_d_coo_cp_from(a,b)
module subroutine psb_d_coo_cp_from(a,b)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a
type(psb_d_coo_sparse_mat), intent(in) :: b
@ -1459,7 +1459,7 @@ module psb_d_base_mat_mod
end interface
interface
subroutine psb_d_coo_mv_from(a,b)
module subroutine psb_d_coo_mv_from(a,b)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a
type(psb_d_coo_sparse_mat), intent(inout) :: b
@ -1484,7 +1484,7 @@ module psb_d_base_mat_mod
!!
!
interface
subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
module subroutine psb_d_coo_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -1499,7 +1499,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_d_coo_csgetptn(imin,imax,a,nz,ia,ja,info,&
module subroutine psb_d_coo_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
@ -1518,7 +1518,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csgetrow
interface
subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
module subroutine psb_d_coo_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
@ -1538,7 +1538,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cssv
interface
subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_coo_cssv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -1551,7 +1551,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cssm
interface
subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_coo_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -1565,7 +1565,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csmv
interface
subroutine psb_d_coo_csmv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_coo_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -1579,7 +1579,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csmm
interface
subroutine psb_d_coo_csmm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_coo_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -1594,7 +1594,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_maxval
interface
function psb_d_coo_maxval(a) result(res)
module function psb_d_coo_maxval(a) result(res)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -1605,7 +1605,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csnmi
interface
function psb_d_coo_csnmi(a) result(res)
module function psb_d_coo_csnmi(a) result(res)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -1616,7 +1616,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csnm1
interface
function psb_d_coo_csnm1(a) result(res)
module function psb_d_coo_csnm1(a) result(res)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -1627,7 +1627,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_rowsum
interface
subroutine psb_d_coo_rowsum(d,a)
module subroutine psb_d_coo_rowsum(d,a)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1637,7 +1637,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_arwsum
interface
subroutine psb_d_coo_arwsum(d,a)
module subroutine psb_d_coo_arwsum(d,a)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1648,7 +1648,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_colsum
interface
subroutine psb_d_coo_colsum(d,a)
module subroutine psb_d_coo_colsum(d,a)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1659,7 +1659,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_aclsum
interface
subroutine psb_d_coo_aclsum(d,a)
module subroutine psb_d_coo_aclsum(d,a)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1670,7 +1670,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_get_diag
interface
subroutine psb_d_coo_get_diag(a,d,info)
module subroutine psb_d_coo_get_diag(a,d,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -1682,7 +1682,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scal
interface
subroutine psb_d_coo_scal(d,a,info,side)
module subroutine psb_d_coo_scal(d,a,info,side)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
@ -1695,7 +1695,7 @@ module psb_d_base_mat_mod
!! \memberof psb_d_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scals
interface
subroutine psb_d_coo_scals(d,a,info)
module subroutine psb_d_coo_scals(d,a,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_dpk_
class(psb_d_coo_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d

66
base/modules/psb_d_csc_mat_mod.f90
Unescape Escape View File

@ -106,7 +106,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_reallocate_nz
interface
subroutine psb_d_csc_reallocate_nz(nz,a)
module subroutine psb_d_csc_reallocate_nz(nz,a)
import :: psb_ipk_, psb_d_csc_sparse_mat
integer(psb_ipk_), intent(in) :: nz
class(psb_d_csc_sparse_mat), intent(inout) :: a
@ -116,7 +116,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_reinit
interface
subroutine psb_d_csc_reinit(a,clear)
module subroutine psb_d_csc_reinit(a,clear)
import :: psb_ipk_, psb_d_csc_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
@ -126,7 +126,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_trim
interface
subroutine psb_d_csc_trim(a)
module subroutine psb_d_csc_trim(a)
import :: psb_ipk_, psb_d_csc_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
end subroutine psb_d_csc_trim
@ -135,7 +135,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_mold
interface
subroutine psb_d_csc_mold(a,b,info)
module subroutine psb_d_csc_mold(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_base_sparse_mat, psb_long_int_k_
class(psb_d_csc_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout), allocatable :: b
@ -146,7 +146,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!| \see psb_base_mat_mod::psb_base_allocate_mnnz
interface
subroutine psb_d_csc_allocate_mnnz(m,n,a,nz)
module subroutine psb_d_csc_allocate_mnnz(m,n,a,nz)
import :: psb_ipk_, psb_d_csc_sparse_mat
integer(psb_ipk_), intent(in) :: m,n
class(psb_d_csc_sparse_mat), intent(inout) :: a
@ -158,7 +158,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_print
interface
subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc)
module subroutine psb_d_csc_print(iout,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_d_csc_sparse_mat
integer(psb_ipk_), intent(in) :: iout
class(psb_d_csc_sparse_mat), intent(in) :: a
@ -171,7 +171,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_to_coo
interface
subroutine psb_d_cp_csc_to_coo(a,b,info)
module subroutine psb_d_cp_csc_to_coo(a,b,info)
import :: psb_ipk_, psb_d_coo_sparse_mat, psb_d_csc_sparse_mat
class(psb_d_csc_sparse_mat), intent(in) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -182,7 +182,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_coo
interface
subroutine psb_d_cp_csc_from_coo(a,b,info)
module subroutine psb_d_cp_csc_from_coo(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_coo_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(in) :: b
@ -193,7 +193,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_to_fmt
interface
subroutine psb_d_cp_csc_to_fmt(a,b,info)
module subroutine psb_d_cp_csc_to_fmt(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_base_sparse_mat
class(psb_d_csc_sparse_mat), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -204,7 +204,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_from_fmt
interface
subroutine psb_d_cp_csc_from_fmt(a,b,info)
module subroutine psb_d_cp_csc_from_fmt(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_base_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
@ -215,7 +215,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_to_coo
interface
subroutine psb_d_mv_csc_to_coo(a,b,info)
module subroutine psb_d_mv_csc_to_coo(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_coo_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -226,7 +226,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_from_coo
interface
subroutine psb_d_mv_csc_from_coo(a,b,info)
module subroutine psb_d_mv_csc_from_coo(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_coo_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_coo_sparse_mat), intent(inout) :: b
@ -237,7 +237,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_to_fmt
interface
subroutine psb_d_mv_csc_to_fmt(a,b,info)
module subroutine psb_d_mv_csc_to_fmt(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_base_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -248,7 +248,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_from_fmt
interface
subroutine psb_d_mv_csc_from_fmt(a,b,info)
module subroutine psb_d_mv_csc_from_fmt(a,b,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_d_base_sparse_mat
class(psb_d_csc_sparse_mat), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -259,7 +259,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cp_from
interface
subroutine psb_d_csc_cp_from(a,b)
module subroutine psb_d_csc_cp_from(a,b)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a
type(psb_d_csc_sparse_mat), intent(in) :: b
@ -269,7 +269,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_mv_from
interface
subroutine psb_d_csc_mv_from(a,b)
module subroutine psb_d_csc_mv_from(a,b)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a
type(psb_d_csc_sparse_mat), intent(inout) :: b
@ -280,7 +280,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csput_a
interface
subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
module subroutine psb_d_csc_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -294,7 +294,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_base_mat_mod::psb_base_csgetptn
interface
subroutine psb_d_csc_csgetptn(imin,imax,a,nz,ia,ja,info,&
module subroutine psb_d_csc_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
@ -312,7 +312,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csgetrow
interface
subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
module subroutine psb_d_csc_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
@ -331,7 +331,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csgetblk
interface
subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,&
module subroutine psb_d_csc_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_, psb_d_coo_sparse_mat
class(psb_d_csc_sparse_mat), intent(in) :: a
@ -348,7 +348,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cssv
interface
subroutine psb_d_csc_cssv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csc_cssv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -360,7 +360,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_cssm
interface
subroutine psb_d_csc_cssm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csc_cssm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -373,7 +373,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csmv
interface
subroutine psb_d_csc_csmv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csc_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -386,7 +386,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csmm
interface
subroutine psb_d_csc_csmm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csc_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -400,7 +400,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_maxval
interface
function psb_d_csc_maxval(a) result(res)
module function psb_d_csc_maxval(a) result(res)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -410,7 +410,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csnm1
interface
function psb_d_csc_csnm1(a) result(res)
module function psb_d_csc_csnm1(a) result(res)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -420,7 +420,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_rowsum
interface
subroutine psb_d_csc_rowsum(d,a)
module subroutine psb_d_csc_rowsum(d,a)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -430,7 +430,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_arwsum
interface
subroutine psb_d_csc_arwsum(d,a)
module subroutine psb_d_csc_arwsum(d,a)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -440,7 +440,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_colsum
interface
subroutine psb_d_csc_colsum(d,a)
module subroutine psb_d_csc_colsum(d,a)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -450,7 +450,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_aclsum
interface
subroutine psb_d_csc_aclsum(d,a)
module subroutine psb_d_csc_aclsum(d,a)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -460,7 +460,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_get_diag
interface
subroutine psb_d_csc_get_diag(a,d,info)
module subroutine psb_d_csc_get_diag(a,d,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
@ -471,7 +471,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scal
interface
subroutine psb_d_csc_scal(d,a,info,side)
module subroutine psb_d_csc_scal(d,a,info,side)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
@ -483,7 +483,7 @@ module psb_d_csc_mat_mod
!> \memberof psb_d_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_scals
interface
subroutine psb_d_csc_scals(d,a,info)
module subroutine psb_d_csc_scals(d,a,info)
import :: psb_ipk_, psb_d_csc_sparse_mat, psb_dpk_
class(psb_d_csc_sparse_mat), intent(inout) :: a
real(psb_dpk_), intent(in) :: d

54
base/modules/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -52,7 +52,7 @@ module psb_d_csr_mat_mod
!! This is a very common storage type, and is the default for assembled
!! matrices in our library
type, extends(psb_d_base_sparse_mat) :: psb_d_csr_sparse_mat
private
!> Pointers to beginning of rows in JA and VAL.
integer(psb_ipk_), allocatable :: irp(:)
!> Column indices.
@ -99,6 +99,10 @@ module psb_d_csr_mat_mod
procedure, pass(a) :: free => d_csr_free
procedure, pass(a) :: mold => psb_d_csr_mold
procedure, pass(a) :: get_irpp => d_csr_get_irpp
procedure, pass(a) :: get_jap => d_csr_get_jap
procedure, pass(a) :: get_valp => d_csr_get_valp
end type psb_d_csr_sparse_mat
private :: d_csr_get_nzeros, d_csr_free, d_csr_get_fmt, &
@ -403,7 +407,7 @@ module psb_d_csr_mat_mod
!> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_maxval
interface
function psb_d_csr_maxval(a) result(res)
module function psb_d_csr_maxval(a) result(res)
import :: psb_ipk_, psb_d_csr_sparse_mat, psb_dpk_
class(psb_d_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -413,7 +417,7 @@ module psb_d_csr_mat_mod
!> \memberof psb_d_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_d_base_csnmi
interface
function psb_d_csr_csnmi(a) result(res)
module function psb_d_csr_csnmi(a) result(res)
import :: psb_ipk_, psb_d_csr_sparse_mat, psb_dpk_
class(psb_d_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
@ -614,4 +618,48 @@ contains
end subroutine d_csr_free
function d_csr_get_irpp(a) result(res)
implicit none
class(psb_d_csr_sparse_mat), intent(in), target :: a
integer(psb_ipk_), pointer :: res(:)
if (allocated(a%irp)) then
res => a%irp
else
res => null()
end if
end function d_csr_get_irpp
function d_csr_get_jap(a) result(res)
implicit none
class(psb_d_csr_sparse_mat), intent(in), target :: a
integer(psb_ipk_), pointer :: res(:)
if (allocated(a%ja)) then
res => a%ja
else
res => null()
end if
end function d_csr_get_jap
function d_csr_get_valp(a) result(res)
implicit none
class(psb_d_csr_sparse_mat), intent(in), target :: a
real(psb_dpk_), pointer :: res(:)
if (allocated(a%val)) then
res => a%val
else
res => null()
end if
end function d_csr_get_valp
end module psb_d_csr_mat_mod

124
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -248,7 +248,7 @@ module psb_d_mat_mod
interface
subroutine psb_d_set_nrows(m,a)
module subroutine psb_d_set_nrows(m,a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: m
@ -256,7 +256,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_ncols(n,a)
module subroutine psb_d_set_ncols(n,a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n
@ -264,7 +264,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_dupl(n,a)
module subroutine psb_d_set_dupl(n,a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: n
@ -272,35 +272,35 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_null(a)
module subroutine psb_d_set_null(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_null
end interface
interface
subroutine psb_d_set_bld(a)
module subroutine psb_d_set_bld(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_bld
end interface
interface
subroutine psb_d_set_upd(a)
module subroutine psb_d_set_upd(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_upd
end interface
interface
subroutine psb_d_set_asb(a)
module subroutine psb_d_set_asb(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_set_asb
end interface
interface
subroutine psb_d_set_sorted(a,val)
module subroutine psb_d_set_sorted(a,val)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: val
@ -308,7 +308,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_triangle(a,val)
module subroutine psb_d_set_triangle(a,val)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: val
@ -316,7 +316,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_unit(a,val)
module subroutine psb_d_set_unit(a,val)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: val
@ -324,7 +324,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_lower(a,val)
module subroutine psb_d_set_lower(a,val)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: val
@ -332,7 +332,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_set_upper(a,val)
module subroutine psb_d_set_upper(a,val)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: val
@ -340,7 +340,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_sparse_print(iout,a,iv,head,ivr,ivc)
module subroutine psb_d_sparse_print(iout,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_dspmat_type
integer(psb_ipk_), intent(in) :: iout
class(psb_dspmat_type), intent(in) :: a
@ -351,7 +351,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_n_sparse_print(fname,a,iv,head,ivr,ivc)
module subroutine psb_d_n_sparse_print(fname,a,iv,head,ivr,ivc)
import :: psb_ipk_, psb_dspmat_type
character(len=*), intent(in) :: fname
class(psb_dspmat_type), intent(in) :: a
@ -362,7 +362,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev)
module subroutine psb_d_get_neigh(a,idx,neigh,n,info,lev)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
integer(psb_ipk_), intent(in) :: idx
@ -374,7 +374,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_csall(nr,nc,a,info,nz)
module subroutine psb_d_csall(nr,nc,a,info,nz)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(in) :: nr,nc
@ -384,7 +384,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_reallocate_nz(nz,a)
module subroutine psb_d_reallocate_nz(nz,a)
import :: psb_ipk_, psb_dspmat_type
integer(psb_ipk_), intent(in) :: nz
class(psb_dspmat_type), intent(inout) :: a
@ -392,21 +392,21 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_free(a)
module subroutine psb_d_free(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_free
end interface
interface
subroutine psb_d_trim(a)
module subroutine psb_d_trim(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_trim
end interface
interface
subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
module subroutine psb_d_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: val(:)
@ -418,7 +418,7 @@ module psb_d_mat_mod
interface
subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
module subroutine psb_d_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
use psb_d_vect_mod, only : psb_d_vect_type
use psb_i_vect_mod, only : psb_i_vect_type
import :: psb_ipk_, psb_dspmat_type
@ -432,7 +432,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_csgetptn(imin,imax,a,nz,ia,ja,info,&
module subroutine psb_d_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -448,7 +448,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
module subroutine psb_d_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -465,7 +465,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_csgetblk(imin,imax,a,b,info,&
module subroutine psb_d_csgetblk(imin,imax,a,b,info,&
& jmin,jmax,iren,append,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -480,7 +480,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_tril(a,b,info,diag,imin,imax,&
module subroutine psb_d_tril(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -492,7 +492,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_triu(a,b,info,diag,imin,imax,&
module subroutine psb_d_triu(a,b,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -505,7 +505,7 @@ module psb_d_mat_mod
interface
subroutine psb_d_csclip(a,b,info,&
module subroutine psb_d_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -517,7 +517,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_b_csclip(a,b,info,&
module subroutine psb_d_b_csclip(a,b,info,&
& imin,imax,jmin,jmax,rscale,cscale)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_coo_sparse_mat
class(psb_dspmat_type), intent(in) :: a
@ -529,7 +529,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_mold(a,b)
module subroutine psb_d_mold(a,b)
import :: psb_ipk_, psb_dspmat_type, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), allocatable, intent(out) :: b
@ -537,7 +537,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_asb(a,mold)
module subroutine psb_d_asb(a,mold)
import :: psb_ipk_, psb_dspmat_type, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), optional, intent(in) :: mold
@ -545,14 +545,14 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_transp_1mat(a)
module subroutine psb_d_transp_1mat(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transp_1mat
end interface
interface
subroutine psb_d_transp_2mat(a,b)
module subroutine psb_d_transp_2mat(a,b)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(inout) :: b
@ -560,14 +560,14 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_transc_1mat(a)
module subroutine psb_d_transc_1mat(a)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
end subroutine psb_d_transc_1mat
end interface
interface
subroutine psb_d_transc_2mat(a,b)
module subroutine psb_d_transc_2mat(a,b)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(inout) :: b
@ -575,7 +575,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_reinit(a,clear)
module subroutine psb_d_reinit(a,clear)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
logical, intent(in), optional :: clear
@ -598,7 +598,7 @@ module psb_d_mat_mod
!
!
interface
subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
module subroutine psb_d_cscnv(a,b,info,type,mold,upd,dupl)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(inout) :: b
@ -611,7 +611,7 @@ module psb_d_mat_mod
interface
subroutine psb_d_cscnv_ip(a,iinfo,type,mold,dupl)
module subroutine psb_d_cscnv_ip(a,iinfo,type,mold,dupl)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_), intent(out) :: iinfo
@ -623,7 +623,7 @@ module psb_d_mat_mod
interface
subroutine psb_d_cscnv_base(a,b,info,dupl)
module subroutine psb_d_cscnv_base(a,b,info,dupl)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(in) :: a
class(psb_d_base_sparse_mat), intent(out) :: b
@ -637,7 +637,7 @@ module psb_d_mat_mod
! out; passes through a COO buffer.
!
interface
subroutine psb_d_clip_d(a,b,info)
module subroutine psb_d_clip_d(a,b,info)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(in) :: a
class(psb_dspmat_type), intent(inout) :: b
@ -646,7 +646,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_clip_d_ip(a,info)
module subroutine psb_d_clip_d_ip(a,info)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
integer(psb_ipk_),intent(out) :: info
@ -658,7 +658,7 @@ module psb_d_mat_mod
! encapsulation between spmat_type and base_sparse_mat.
!
interface
subroutine psb_d_mv_from(a,b)
module subroutine psb_d_mv_from(a,b)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -666,7 +666,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_cp_from(a,b)
module subroutine psb_d_cp_from(a,b)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(out) :: a
class(psb_d_base_sparse_mat), intent(in) :: b
@ -674,7 +674,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_mv_to(a,b)
module subroutine psb_d_mv_to(a,b)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(inout) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -682,7 +682,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_d_cp_to(a,b)
module subroutine psb_d_cp_to(a,b)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_, psb_d_base_sparse_mat
class(psb_dspmat_type), intent(in) :: a
class(psb_d_base_sparse_mat), intent(inout) :: b
@ -693,7 +693,7 @@ module psb_d_mat_mod
! Transfer the internal allocation to the target.
!
interface psb_move_alloc
subroutine psb_dspmat_type_move(a,b,info)
module subroutine psb_dspmat_type_move(a,b,info)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
class(psb_dspmat_type), intent(inout) :: b
@ -702,7 +702,7 @@ module psb_d_mat_mod
end interface
interface
subroutine psb_dspmat_clone(a,b,info)
module subroutine psb_dspmat_clone(a,b,info)
import :: psb_ipk_, psb_dspmat_type
class(psb_dspmat_type), intent(inout) :: a
class(psb_dspmat_type), intent(inout) :: b
@ -727,7 +727,7 @@ module psb_d_mat_mod
! == ===================================
interface psb_csmm
subroutine psb_d_csmm(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csmm(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -735,7 +735,7 @@ module psb_d_mat_mod
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_d_csmm
subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csmv(alpha,a,x,beta,y,info,trans)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -743,7 +743,7 @@ module psb_d_mat_mod
integer(psb_ipk_), intent(out) :: info
character, optional, intent(in) :: trans
end subroutine psb_d_csmv
subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
module subroutine psb_d_csmv_vect(alpha,a,x,beta,y,info,trans)
use psb_d_vect_mod, only : psb_d_vect_type
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -756,7 +756,7 @@ module psb_d_mat_mod
end interface
interface psb_cssm
subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
module subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:,:)
@ -765,7 +765,7 @@ module psb_d_mat_mod
character, optional, intent(in) :: trans, scale
real(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_d_cssm
subroutine psb_d_cssv(alpha,a,x,beta,y,info,trans,scale,d)
module subroutine psb_d_cssv(alpha,a,x,beta,y,info,trans,scale,d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), intent(in) :: alpha, beta, x(:)
@ -774,7 +774,7 @@ module psb_d_mat_mod
character, optional, intent(in) :: trans, scale
real(psb_dpk_), intent(in), optional :: d(:)
end subroutine psb_d_cssv
subroutine psb_d_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d)
module subroutine psb_d_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d)
use psb_d_vect_mod, only : psb_d_vect_type
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
@ -788,7 +788,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_maxval(a) result(res)
module function psb_d_maxval(a) result(res)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_) :: res
@ -796,7 +796,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_csnmi(a) result(res)
module function psb_d_csnmi(a) result(res)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_) :: res
@ -804,7 +804,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_csnm1(a) result(res)
module function psb_d_csnm1(a) result(res)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_) :: res
@ -812,7 +812,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_rowsum(a,info) result(d)
module function psb_d_rowsum(a,info) result(d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
@ -821,7 +821,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_arwsum(a,info) result(d)
module function psb_d_arwsum(a,info) result(d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
@ -830,7 +830,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_colsum(a,info) result(d)
module function psb_d_colsum(a,info) result(d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
@ -839,7 +839,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_aclsum(a,info) result(d)
module function psb_d_aclsum(a,info) result(d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
@ -848,7 +848,7 @@ module psb_d_mat_mod
end interface
interface
function psb_d_get_diag(a,info) result(d)
module function psb_d_get_diag(a,info) result(d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
@ -857,14 +857,14 @@ module psb_d_mat_mod
end interface
interface psb_scal
subroutine psb_d_scal(d,a,info,side)
module subroutine psb_d_scal(d,a,info,side)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: d(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in), optional :: side
end subroutine psb_d_scal
subroutine psb_d_scals(d,a,info)
module subroutine psb_d_scals(d,a,info)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(inout) :: a
real(psb_dpk_), intent(in) :: d

85
base/modules/psb_d_sort_mod.f90
Unescape Escape View File

@ -71,7 +71,7 @@ module psb_d_sort_mod
interface psb_msort
subroutine psb_dmsort(x,ix,dir,flag)
module subroutine psb_dmsort(x,ix,dir,flag)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
@ -80,14 +80,14 @@ module psb_d_sort_mod
end interface psb_msort
interface
subroutine psi_d_msort_up(n,k,l,iret)
module subroutine psi_d_msort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_msort_up
subroutine psi_d_msort_dw(n,k,l,iret)
module subroutine psi_d_msort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
@ -96,14 +96,14 @@ module psb_d_sort_mod
end subroutine psi_d_msort_dw
end interface
interface
subroutine psi_d_amsort_up(n,k,l,iret)
module subroutine psi_d_amsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_amsort_up
subroutine psi_d_amsort_dw(n,k,l,iret)
module subroutine psi_d_amsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
@ -114,7 +114,7 @@ module psb_d_sort_mod
interface psb_qsort
subroutine psb_dqsort(x,ix,dir,flag)
module subroutine psb_dqsort(x,ix,dir,flag)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
@ -123,7 +123,7 @@ module psb_d_sort_mod
end interface psb_qsort
interface psb_isort
subroutine psb_disort(x,ix,dir,flag)
module subroutine psb_disort(x,ix,dir,flag)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
@ -133,7 +133,7 @@ module psb_d_sort_mod
interface psb_hsort
subroutine psb_dhsort(x,ix,dir,flag)
module subroutine psb_dhsort(x,ix,dir,flag)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
@ -142,35 +142,8 @@ module psb_d_sort_mod
end interface psb_hsort
!!$ interface !psb_howmany_heap
!!$ module procedure psb_d_howmany, psb_d_idx_howmany
!!$ end interface
!!$
!!$
!!$ interface !psb_init_heap
!!$ module procedure psb_d_init_heap, psb_d_idx_init_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_dump_heap
!!$ module procedure psb_d_dump_heap, psb_dump_d_idx_heap
!!$ end interface
!!$
!!$
!!$ interface !psb_insert_heap
!!$ module procedure psb_d_insert_heap, psb_d_idx_insert_heap
!!$ end interface
!!$
!!$ interface !psb_heap_get_first
!!$ module procedure psb_d_heap_get_first, psb_d_idx_heap_get_first
!!$ end interface
!!$
!!$ interface !psb_free_heap
!!$ module procedure psb_free_d_heap, psb_free_d_idx_heap
!!$ end interface
interface
subroutine psi_d_insert_heap(key,last,heap,dir,info)
module subroutine psi_d_insert_heap(key,last,heap,dir,info)
import
implicit none
@ -190,7 +163,7 @@ module psb_d_sort_mod
end interface
interface
subroutine psi_d_idx_insert_heap(key,index,last,heap,idxs,dir,info)
module subroutine psi_d_idx_insert_heap(key,index,last,heap,idxs,dir,info)
import
implicit none
@ -213,7 +186,7 @@ module psb_d_sort_mod
interface
subroutine psi_d_heap_get_first(key,last,heap,dir,info)
module subroutine psi_d_heap_get_first(key,last,heap,dir,info)
import
implicit none
real(psb_dpk_), intent(inout) :: key
@ -225,7 +198,7 @@ module psb_d_sort_mod
end interface
interface
subroutine psi_d_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
module subroutine psi_d_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
import
real(psb_dpk_), intent(inout) :: key
integer(psb_ipk_), intent(out) :: index
@ -238,46 +211,46 @@ module psb_d_sort_mod
end interface
interface
subroutine psi_disrx_up(n,x,ix)
module subroutine psi_disrx_up(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_disrx_up
subroutine psi_disrx_dw(n,x,ix)
module subroutine psi_disrx_dw(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_disrx_dw
subroutine psi_disr_up(n,x)
module subroutine psi_disr_up(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_disr_up
subroutine psi_disr_dw(n,x)
module subroutine psi_disr_dw(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_disr_dw
subroutine psi_daisrx_up(n,x,ix)
module subroutine psi_daisrx_up(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daisrx_up
subroutine psi_daisrx_dw(n,x,ix)
module subroutine psi_daisrx_dw(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daisrx_dw
subroutine psi_daisr_up(n,x)
module subroutine psi_daisr_up(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daisr_up
subroutine psi_daisr_dw(n,x)
module subroutine psi_daisr_dw(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
@ -285,50 +258,50 @@ module psb_d_sort_mod
end interface
interface
subroutine psi_dqsrx_up(n,x,ix)
module subroutine psi_dqsrx_up(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_dqsrx_up
subroutine psi_dqsrx_dw(n,x,ix)
module subroutine psi_dqsrx_dw(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_dqsrx_dw
subroutine psi_dqsr_up(n,x)
module subroutine psi_dqsr_up(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_dqsr_up
subroutine psi_dqsr_dw(n,x)
module subroutine psi_dqsr_dw(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_dqsr_dw
subroutine psi_daqsrx_up(n,x,ix)
module subroutine psi_daqsrx_up(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daqsrx_up
subroutine psi_daqsrx_dw(n,x,ix)
module subroutine psi_daqsrx_dw(n,x,ix)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daqsrx_dw
subroutine psi_daqsr_up(n,x)
module subroutine psi_daqsr_up(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daqsr_up
subroutine psi_daqsr_dw(n,x)
module subroutine psi_daqsr_dw(n,x)
import
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
end subroutine psi_daqsr_dw
end subroutine psi_daqsr_dw
end interface
contains

257
base/modules/psb_error_impl.F90
Unescape Escape View File

@ -1,152 +1,151 @@
! checks wether an error has occurred on one of the porecesses in the execution pool
subroutine psb_errcomm(ictxt, err)
use psb_error_mod, psb_protect_name => psb_errcomm
use psb_penv_mod
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(inout):: err
call psb_amx(ictxt, err)
end subroutine psb_errcomm
subroutine psb_ser_error_handler(err_act)
use psb_error_mod, psb_protect_name => psb_ser_error_handler
use psb_penv_mod
implicit none
integer(psb_ipk_), intent(inout) :: err_act
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) &
& call psb_error()
if (err_act == psb_act_abort_) stop
return
end subroutine psb_ser_error_handler
subroutine psb_par_error_handler(ictxt,err_act)
use psb_error_mod, psb_protect_name => psb_par_error_handler
use psb_penv_mod
implicit none
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: err_act
call psb_erractionrestore(err_act)
if (err_act == psb_act_print_) &
& call psb_error(ictxt, abrt=.false.)
if (err_act == psb_act_abort_) &
& call psb_error(ictxt, abrt=.true.)
return
end subroutine psb_par_error_handler
subroutine psb_par_error_print_stack(ictxt)
use psb_error_mod, psb_protect_name => psb_par_error_print_stack
use psb_penv_mod
integer(psb_mpik_), intent(in) :: ictxt
call psb_error(ictxt, abrt=.false.)
end subroutine psb_par_error_print_stack
subroutine psb_ser_error_print_stack()
use psb_error_mod, psb_protect_name => psb_ser_error_print_stack
call psb_error()
end subroutine psb_ser_error_print_stack
! handles the occurence of an error in a serial routine
subroutine psb_serror()
use psb_const_mod
use psb_error_mod
implicit none
integer(psb_ipk_) :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer(psb_ipk_) :: i_e_d(5)
if (psb_errstatus_fatal()) then
if(psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(psb_err_unit,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d)
! write(psb_err_unit,'(50("="))')
end do
submodule (psb_error_mod) psb_error_impl_mod
contains
! checks wether an error has occurred on one of the porecesses in the execution pool
subroutine psb_errcomm(ictxt, err)
use psb_penv_mod
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(inout):: err
call psb_amx(ictxt, err)
end subroutine psb_errcomm
subroutine psb_ser_error_handler(err_act)
use psb_penv_mod
implicit none
integer(psb_ipk_), intent(inout) :: err_act
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) &
& call psb_error()
if (err_act == psb_act_abort_) stop
return
end subroutine psb_ser_error_handler
subroutine psb_par_error_handler(ictxt,err_act)
use psb_penv_mod
implicit none
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: err_act
call psb_erractionrestore(err_act)
if (err_act == psb_act_print_) &
& call psb_error(ictxt, abrt=.false.)
if (err_act == psb_act_abort_) &
& call psb_error(ictxt, abrt=.true.)
return
end subroutine psb_par_error_handler
subroutine psb_par_error_print_stack(ictxt)
use psb_penv_mod
integer(psb_mpik_), intent(in) :: ictxt
call psb_error(ictxt, abrt=.false.)
end subroutine psb_par_error_print_stack
else
subroutine psb_ser_error_print_stack()
call psb_error()
end subroutine psb_ser_error_print_stack
! handles the occurence of an error in a serial routine
subroutine psb_serror()
use psb_const_mod
use psb_error_mod
implicit none
integer(psb_ipk_) :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer(psb_ipk_) :: i_e_d(5)
if (psb_errstatus_fatal()) then
if(psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(psb_err_unit,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d)
! write(psb_err_unit,'(50("="))')
end do
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d)
do while (psb_get_numerr() > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d)
do while (psb_get_numerr() > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
end if
end if
end if
#if defined(HAVE_FLUSH_STMT)
flush(psb_err_unit)
flush(psb_err_unit)
#endif
end subroutine psb_serror
end subroutine psb_serror
! handles the occurence of an error in a parallel routine
subroutine psb_perror(ictxt,abrt)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
integer(psb_mpik_), intent(in) :: ictxt
logical, intent(in), optional :: abrt
! handles the occurence of an error in a parallel routine
subroutine psb_perror(ictxt,abrt)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
integer(psb_mpik_), intent(in) :: ictxt
logical, intent(in), optional :: abrt
integer(psb_ipk_) :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer(psb_ipk_) :: i_e_d(5)
integer(psb_mpik_) :: iam, np
logical :: abrt_
integer(psb_ipk_) :: err_c
character(len=20) :: r_name
character(len=40) :: a_e_d
integer(psb_ipk_) :: i_e_d(5)
integer(psb_mpik_) :: iam, np
logical :: abrt_
abrt_=.true.
if (present(abrt)) abrt_=abrt
call psb_info(ictxt,iam,np)
if (psb_errstatus_fatal()) then
if (psb_get_errverbosity() > 1) then
abrt_=.true.
if (present(abrt)) abrt_=abrt
call psb_info(ictxt,iam,np)
do while (psb_get_numerr() > izero)
write(psb_err_unit,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam)
! write(psb_err_unit,'(50("="))')
end do
if (psb_errstatus_fatal()) then
if (psb_get_errverbosity() > 1) then
do while (psb_get_numerr() > izero)
write(psb_err_unit,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam)
! write(psb_err_unit,'(50("="))')
end do
#if defined(HAVE_FLUSH_STMT)
flush(psb_err_unit)
flush(psb_err_unit)
#endif
if (abrt_) call psb_abort(ictxt,-1)
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam)
do while (psb_get_numerr() > 0)
if (abrt_) call psb_abort(ictxt,-1)
else
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
call psb_errmsg(psb_err_unit,err_c, r_name, i_e_d, a_e_d,iam)
do while (psb_get_numerr() > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
#if defined(HAVE_FLUSH_STMT)
flush(psb_err_unit)
flush(psb_err_unit)
#endif
if (abrt_) call psb_abort(ictxt,-1)
if (abrt_) call psb_abort(ictxt,-1)
end if
end if
end if
end subroutine psb_perror
end subroutine psb_perror
end submodule psb_error_impl_mod

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

@ -67,11 +67,11 @@ module psb_error_mod
interface psb_error_handler
subroutine psb_ser_error_handler(err_act)
module subroutine psb_ser_error_handler(err_act)
import :: psb_ipk_
integer(psb_ipk_), intent(inout) :: err_act
end subroutine psb_ser_error_handler
subroutine psb_par_error_handler(ictxt,err_act)
module subroutine psb_par_error_handler(ictxt,err_act)
import :: psb_ipk_,psb_mpik_
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(in) :: err_act
@ -79,9 +79,9 @@ module psb_error_mod
end interface
interface psb_error
subroutine psb_serror()
module subroutine psb_serror()
end subroutine psb_serror
subroutine psb_perror(ictxt,abrt)
module subroutine psb_perror(ictxt,abrt)
import :: psb_mpik_
integer(psb_mpik_), intent(in) :: ictxt
logical, intent(in), optional :: abrt
@ -90,16 +90,16 @@ module psb_error_mod
interface psb_error_print_stack
subroutine psb_par_error_print_stack(ictxt)
module subroutine psb_par_error_print_stack(ictxt)
import :: psb_ipk_,psb_mpik_
integer(psb_mpik_), intent(in) :: ictxt
end subroutine psb_par_error_print_stack
subroutine psb_ser_error_print_stack()
module subroutine psb_ser_error_print_stack()
end subroutine psb_ser_error_print_stack
end interface
interface psb_errcomm
subroutine psb_errcomm(ictxt, err)
module subroutine psb_errcomm(ictxt, err)
import :: psb_mpik_, psb_ipk_
integer(psb_mpik_), intent(in) :: ictxt
integer(psb_ipk_), intent(inout):: err

42
base/modules/psi_d_mod.f90
Unescape Escape View File

@ -35,7 +35,7 @@ module psi_d_mod
interface psi_swapdata
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
module subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(out) :: info
@ -44,7 +44,7 @@ module psi_d_mod
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswapdatam
subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
module subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
@ -53,7 +53,7 @@ module psi_d_mod
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswapdatav
subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
module subroutine psi_dswapdata_vect(flag,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
@ -63,7 +63,7 @@ module psi_d_mod
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswapdata_vect
subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,&
module subroutine psi_dswapidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
@ -72,7 +72,7 @@ module psi_d_mod
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dswapidxm
subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,&
module subroutine psi_dswapidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
@ -81,7 +81,7 @@ module psi_d_mod
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dswapidxv
subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
module subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
@ -96,7 +96,7 @@ module psi_d_mod
interface psi_swaptran
subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
module subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag, n
integer(psb_ipk_), intent(out) :: info
@ -105,7 +105,7 @@ module psi_d_mod
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswaptranm
subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
module subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
@ -114,7 +114,7 @@ module psi_d_mod
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswaptranv
subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
module subroutine psi_dswaptran_vect(flag,beta,y,desc_a,work,info,data)
import
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
@ -124,7 +124,7 @@ module psi_d_mod
type(psb_desc_type), target :: desc_a
integer(psb_ipk_), optional :: data
end subroutine psi_dswaptran_vect
subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,&
module subroutine psi_dtranidxm(ictxt,icomm,flag,n,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag, n
@ -133,7 +133,7 @@ module psi_d_mod
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dtranidxm
subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,&
module subroutine psi_dtranidxv(ictxt,icomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import
integer(psb_ipk_), intent(in) :: ictxt,icomm,flag
@ -142,7 +142,7 @@ module psi_d_mod
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dtranidxv
subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
module subroutine psi_dtran_vidx_vect(iictxt,iicomm,flag,beta,y,idx,&
& totxch,totsnd,totrcv,work,info)
import
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
@ -156,21 +156,21 @@ module psi_d_mod
end interface
interface psi_ovrl_upd
subroutine psi_dovrl_updr1(x,desc_a,update,info)
module subroutine psi_dovrl_updr1(x,desc_a,update,info)
import
real(psb_dpk_), intent(inout), target :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_updr1
subroutine psi_dovrl_updr2(x,desc_a,update,info)
module subroutine psi_dovrl_updr2(x,desc_a,update,info)
import
real(psb_dpk_), intent(inout), target :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(in) :: update
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_updr2
subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
module subroutine psi_dovrl_upd_vect(x,desc_a,update,info)
import
class(psb_d_base_vect_type) :: x
type(psb_desc_type), intent(in) :: desc_a
@ -180,21 +180,21 @@ module psi_d_mod
end interface
interface psi_ovrl_save
subroutine psi_dovrl_saver1(x,xs,desc_a,info)
module subroutine psi_dovrl_saver1(x,xs,desc_a,info)
import
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_), allocatable :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_saver1
subroutine psi_dovrl_saver2(x,xs,desc_a,info)
module subroutine psi_dovrl_saver2(x,xs,desc_a,info)
import
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_), allocatable :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_saver2
subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
module subroutine psi_dovrl_save_vect(x,xs,desc_a,info)
import
class(psb_d_base_vect_type) :: x
real(psb_dpk_), allocatable :: xs(:)
@ -204,21 +204,21 @@ module psi_d_mod
end interface
interface psi_ovrl_restore
subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
module subroutine psi_dovrl_restrr1(x,xs,desc_a,info)
import
real(psb_dpk_), intent(inout) :: x(:)
real(psb_dpk_) :: xs(:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_restrr1
subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
module subroutine psi_dovrl_restrr2(x,xs,desc_a,info)
import
real(psb_dpk_), intent(inout) :: x(:,:)
real(psb_dpk_) :: xs(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
end subroutine psi_dovrl_restrr2
subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
module subroutine psi_dovrl_restr_vect(x,xs,desc_a,info)
import
class(psb_d_base_vect_type) :: x
real(psb_dpk_) :: xs(:)

86
base/modules/psi_serial_mod.f90
Unescape Escape View File

@ -33,7 +33,7 @@ module psi_serial_mod
use psb_const_mod, only : psb_ipk_, psb_spk_, psb_dpk_
interface psb_gelp
! 2-D version
subroutine psb_sgelp(trans,iperm,x,info)
module subroutine psb_sgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
real(psb_spk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -41,14 +41,14 @@ module psi_serial_mod
character, intent(in) :: trans
end subroutine psb_sgelp
! 1-D version
subroutine psb_sgelpv(trans,iperm,x,info)
module subroutine psb_sgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
integer(psb_ipk_), intent(out) :: info
character, intent(in) :: trans
end subroutine psb_sgelpv
subroutine psb_dgelp(trans,iperm,x,info)
module subroutine psb_dgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
real(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -56,7 +56,7 @@ module psi_serial_mod
character, intent(in) :: trans
end subroutine psb_dgelp
! 1-D version
subroutine psb_dgelpv(trans,iperm,x,info)
module subroutine psb_dgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -64,7 +64,7 @@ module psi_serial_mod
character, intent(in) :: trans
end subroutine psb_dgelpv
! 2-D version
subroutine psb_cgelp(trans,iperm,x,info)
module subroutine psb_cgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
complex(psb_spk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -72,7 +72,7 @@ module psi_serial_mod
character, intent(in) :: trans
end subroutine psb_cgelp
! 1-D version
subroutine psb_cgelpv(trans,iperm,x,info)
module subroutine psb_cgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -80,7 +80,7 @@ module psi_serial_mod
character, intent(in) :: trans
end subroutine psb_cgelpv
! 2-D version
subroutine psb_zgelp(trans,iperm,x,info)
module subroutine psb_zgelp(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
complex(psb_dpk_), intent(inout) :: x(:,:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -88,7 +88,7 @@ module psi_serial_mod
character, intent(in) :: trans
end subroutine psb_zgelp
! 1-D version
subroutine psb_zgelpv(trans,iperm,x,info)
module subroutine psb_zgelpv(trans,iperm,x,info)
import :: psb_ipk_, psb_spk_, psb_dpk_
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: iperm(:)
@ -100,77 +100,77 @@ module psi_serial_mod
interface psi_gth
subroutine psi_igthv(n,idx,alpha,x,beta,y)
module subroutine psi_igthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:), alpha, beta
end subroutine psi_igthv
subroutine psi_sgthv(n,idx,alpha,x,beta,y)
module subroutine psi_sgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: x(:), y(:), alpha, beta
end subroutine psi_sgthv
subroutine psi_dgthv(n,idx,alpha,x,beta,y)
module subroutine psi_dgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: x(:), y(:), alpha, beta
end subroutine psi_dgthv
subroutine psi_cgthv(n,idx,alpha,x,beta,y)
module subroutine psi_cgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: x(:), y(:),alpha,beta
end subroutine psi_cgthv
subroutine psi_zgthv(n,idx,alpha,x,beta,y)
module subroutine psi_zgthv(n,idx,alpha,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: x(:), y(:),alpha,beta
end subroutine psi_zgthv
subroutine psi_sgthzmv(n,k,idx,x,y)
module subroutine psi_sgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
real(psb_spk_) :: x(:,:), y(:)
end subroutine psi_sgthzmv
subroutine psi_dgthzmv(n,k,idx,x,y)
module subroutine psi_dgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
real(psb_dpk_) :: x(:,:), y(:)
end subroutine psi_dgthzmv
subroutine psi_igthzmv(n,k,idx,x,y)
module subroutine psi_igthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: x(:,:), y(:)
end subroutine psi_igthzmv
subroutine psi_cgthzmv(n,k,idx,x,y)
module subroutine psi_cgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_spk_) :: x(:,:), y(:)
end subroutine psi_cgthzmv
subroutine psi_zgthzmv(n,k,idx,x,y)
module subroutine psi_zgthzmv(n,k,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_dpk_) :: x(:,:), y(:)
end subroutine psi_zgthzmv
subroutine psi_sgthzv(n,idx,x,y)
module subroutine psi_sgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: x(:), y(:)
end subroutine psi_sgthzv
subroutine psi_dgthzv(n,idx,x,y)
module subroutine psi_dgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: x(:), y(:)
end subroutine psi_dgthzv
subroutine psi_igthzv(n,idx,x,y)
module subroutine psi_igthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: x(:), y(:)
end subroutine psi_igthzv
subroutine psi_cgthzv(n,idx,x,y)
module subroutine psi_cgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: x(:), y(:)
end subroutine psi_cgthzv
subroutine psi_zgthzv(n,idx,x,y)
module subroutine psi_zgthzv(n,idx,x,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: x(:), y(:)
@ -179,52 +179,52 @@ module psi_serial_mod
interface psi_sct
subroutine psi_ssctmv(n,k,idx,x,beta,y)
module subroutine psi_ssctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
real(psb_spk_) :: beta, x(:), y(:,:)
end subroutine psi_ssctmv
subroutine psi_ssctv(n,idx,x,beta,y)
module subroutine psi_ssctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
real(psb_spk_) :: beta, x(:), y(:)
end subroutine psi_ssctv
subroutine psi_dsctmv(n,k,idx,x,beta,y)
module subroutine psi_dsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
real(psb_dpk_) :: beta, x(:), y(:,:)
end subroutine psi_dsctmv
subroutine psi_dsctv(n,idx,x,beta,y)
module subroutine psi_dsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
real(psb_dpk_) :: beta, x(:), y(:)
end subroutine psi_dsctv
subroutine psi_isctmv(n,k,idx,x,beta,y)
module subroutine psi_isctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:,:)
end subroutine psi_isctmv
subroutine psi_isctv(n,idx,x,beta,y)
module subroutine psi_isctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
integer(psb_ipk_) :: beta, x(:), y(:)
end subroutine psi_isctv
subroutine psi_csctmv(n,k,idx,x,beta,y)
module subroutine psi_csctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_spk_) :: beta, x(:), y(:,:)
end subroutine psi_csctmv
subroutine psi_csctv(n,idx,x,beta,y)
module subroutine psi_csctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
complex(psb_spk_) :: beta, x(:), y(:)
end subroutine psi_csctv
subroutine psi_zsctmv(n,k,idx,x,beta,y)
module subroutine psi_zsctmv(n,k,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, k, idx(:)
complex(psb_dpk_) :: beta, x(:), y(:,:)
end subroutine psi_zsctmv
subroutine psi_zsctv(n,idx,x,beta,y)
module subroutine psi_zsctv(n,idx,x,beta,y)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_) :: n, idx(:)
complex(psb_dpk_) :: beta, x(:), y(:)
@ -233,7 +233,7 @@ module psi_serial_mod
interface psb_geaxpby
subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
module subroutine psi_iaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m
integer(psb_ipk_), intent (in) :: x(:)
@ -241,7 +241,7 @@ module psi_serial_mod
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_iaxpbyv
subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
module subroutine psi_iaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m, n
integer(psb_ipk_), intent (in) :: x(:,:)
@ -249,7 +249,7 @@ module psi_serial_mod
integer(psb_ipk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_iaxpby
subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
module subroutine psi_saxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m
real(psb_spk_), intent (in) :: x(:)
@ -257,7 +257,7 @@ module psi_serial_mod
real(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_saxpbyv
subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
module subroutine psi_saxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m, n
real(psb_spk_), intent (in) :: x(:,:)
@ -265,7 +265,7 @@ module psi_serial_mod
real(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_saxpby
subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
module subroutine psi_daxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m
real(psb_dpk_), intent (in) :: x(:)
@ -273,7 +273,7 @@ module psi_serial_mod
real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_daxpbyv
subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
module subroutine psi_daxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m, n
real(psb_dpk_), intent (in) :: x(:,:)
@ -281,7 +281,7 @@ module psi_serial_mod
real(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_daxpby
subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
module subroutine psi_caxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m
complex(psb_spk_), intent (in) :: x(:)
@ -289,7 +289,7 @@ module psi_serial_mod
complex(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_caxpbyv
subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
module subroutine psi_caxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
implicit none
integer(psb_ipk_), intent(in) :: m, n
@ -298,7 +298,7 @@ module psi_serial_mod
complex(psb_spk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_caxpby
subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
module subroutine psi_zaxpbyv(m,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m
complex(psb_dpk_), intent (in) :: x(:)
@ -306,7 +306,7 @@ module psi_serial_mod
complex(psb_dpk_), intent (in) :: alpha, beta
integer(psb_ipk_), intent(out) :: info
end subroutine psi_zaxpbyv
subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
module subroutine psi_zaxpby(m,n,alpha, x, beta, y, info)
import :: psb_ipk_, psb_spk_, psb_dpk_
integer(psb_ipk_), intent(in) :: m, n
complex(psb_dpk_), intent (in) :: x(:,:)

563
base/serial/impl/psb_base_mat_impl.f90
Unescape Escape View File

@ -1,295 +1,288 @@
function psb_base_get_nz_row(idx,a) result(res)
use psb_error_mod
use psb_base_mat_mod, psb_protect_name => psb_base_get_nz_row
implicit none
integer(psb_ipk_), intent(in) :: idx
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='base_get_nz_row'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_base_get_nz_row
function psb_base_get_nzeros(a) result(res)
use psb_base_mat_mod, psb_protect_name => psb_base_get_nzeros
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='base_get_nzeros'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_base_get_nzeros
function psb_base_get_size(a) result(res)
use psb_base_mat_mod, psb_protect_name => psb_base_get_size
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_base_get_size
subroutine psb_base_reinit(a,clear)
use psb_base_mat_mod, psb_protect_name => psb_base_reinit
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='reinit'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_err_missing_override_method_
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_reinit
subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc)
use psb_base_mat_mod, psb_protect_name => psb_base_sparse_print
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: iout
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='sparse_print'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_err_missing_override_method_
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_sparse_print
subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
use psb_base_mat_mod, psb_protect_name => psb_base_csgetptn
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_csgetptn
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
use psb_base_mat_mod, psb_protect_name => psb_base_get_neigh
use psb_error_mod
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: idx
integer(psb_ipk_), intent(out) :: n
integer(psb_ipk_), allocatable, intent(out) :: neigh(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: lev
integer(psb_ipk_) :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl,ma
integer(psb_ipk_), allocatable :: ia(:), ja(:)
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if(present(lev)) then
lev_ = lev
else
lev_=1
end if
! Turns out we can write get_neigh at this
! level
n = 0
ma = a%get_nrows()
call a%csget(idx,idx,n,ia,ja,info)
if (info == psb_success_) call psb_realloc(n,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
submodule (psb_base_mat_mod) psb_base_mat_impl_mod
contains
function psb_base_get_nz_row(idx,a) result(res)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: idx
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='base_get_nz_row'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_base_get_nz_row
function psb_base_get_nzeros(a) result(res)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='base_get_nzeros'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_base_get_nzeros
function psb_base_get_size(a) result(res)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_) :: res
integer(psb_ipk_) :: err_act
character(len=20) :: name='get_size'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
res = -1
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end function psb_base_get_size
subroutine psb_base_reinit(a,clear)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
logical, intent(in), optional :: clear
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='reinit'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_err_missing_override_method_
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_reinit
subroutine psb_base_sparse_print(iout,a,iv,head,ivr,ivc)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: iout
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in), optional :: iv(:)
character(len=*), optional :: head
integer(psb_ipk_), intent(in), optional :: ivr(:), ivc(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='sparse_print'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_err_missing_override_method_
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_sparse_print
subroutine psb_base_csgetptn(imin,imax,a,nz,ia,ja,info,&
& jmin,jmax,iren,append,nzin,rscale,cscale)
! Output is always in COO format
use psb_error_mod
use psb_const_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: imin,imax
integer(psb_ipk_), intent(out) :: nz
integer(psb_ipk_), allocatable, intent(inout) :: ia(:), ja(:)
integer(psb_ipk_),intent(out) :: info
logical, intent(in), optional :: append
integer(psb_ipk_), intent(in), optional :: iren(:)
integer(psb_ipk_), intent(in), optional :: jmin,jmax, nzin
logical, intent(in), optional :: rscale,cscale
integer(psb_ipk_) :: err_act
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_csgetptn
subroutine psb_base_get_neigh(a,idx,neigh,n,info,lev)
use psb_error_mod
use psb_realloc_mod
use psb_sort_mod
implicit none
class(psb_base_sparse_mat), intent(in) :: a
integer(psb_ipk_), intent(in) :: idx
integer(psb_ipk_), intent(out) :: n
integer(psb_ipk_), allocatable, intent(out) :: neigh(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: lev
integer(psb_ipk_) :: lev_, i, nl, ifl,ill,&
& n1, err_act, nn, nidx,ntl,ma
integer(psb_ipk_), allocatable :: ia(:), ja(:)
character(len=20) :: name='get_neigh'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if(present(lev)) then
lev_ = lev
else
lev_=1
end if
! Turns out we can write get_neigh at this
! level
n = 0
ma = a%get_nrows()
call a%csget(idx,idx,n,ia,ja,info)
if (info == psb_success_) call psb_realloc(n,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx /= idx).and.(nidx > 0).and.(nidx <= ma)) then
call a%csget(nidx,nidx,nn,ia,ja,info)
if (info == psb_success_) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
neigh(1:n) = ja(1:n)
ifl = 1
ill = n
do nl = 2, lev_
n1 = ill - ifl + 1
call psb_ensure_size(ill+n1*n1,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
ntl = 0
do i=ifl,ill
nidx=neigh(i)
if ((nidx /= idx).and.(nidx > 0).and.(nidx <= ma)) then
call a%csget(nidx,nidx,nn,ia,ja,info)
if (info == psb_success_) call psb_ensure_size(ill+ntl+nn,neigh,info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_dealloc_,name)
goto 9999
end if
neigh(ill+ntl+1:ill+ntl+nn)=ja(1:nn)
ntl = ntl+nn
end if
end do
call psb_msort_unique(neigh(ill+1:ill+ntl),nn,dir=psb_sort_up_)
ifl = ill + 1
ill = ill + nn
end do
call psb_msort_unique(neigh(ill+1:ill+ntl),nn,dir=psb_sort_up_)
ifl = ill + 1
ill = ill + nn
end do
call psb_msort_unique(neigh(1:ill),nn,dir=psb_sort_up_)
n = nn
call psb_msort_unique(neigh(1:ill),nn,dir=psb_sort_up_)
n = nn
call psb_erractionrestore(err_act)
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_base_get_neigh
subroutine psb_base_allocate_mnnz(m,n,a,nz)
use psb_base_mat_mod, psb_protect_name => psb_base_allocate_mnnz
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(in), optional :: nz
integer(psb_ipk_) :: err_act
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_allocate_mnnz
subroutine psb_base_reallocate_nz(nz,a)
use psb_base_mat_mod, psb_protect_name => psb_base_reallocate_nz
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: nz
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_reallocate_nz
subroutine psb_base_free(a)
use psb_base_mat_mod, psb_protect_name => psb_base_free
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='free'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_free
subroutine psb_base_trim(a)
use psb_base_mat_mod, psb_protect_name => psb_base_trim
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='trim'
logical, parameter :: debug=.false.
!
! This is the base version.
! The correct action is: do nothing.
! Indeed, the more complicated the data structure, the
! more likely this is the only possible course.
!
return
end subroutine psb_base_trim
return
end subroutine psb_base_get_neigh
subroutine psb_base_allocate_mnnz(m,n,a,nz)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: m,n
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_), intent(in), optional :: nz
integer(psb_ipk_) :: err_act
character(len=20) :: name='allocate_mnz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_allocate_mnnz
subroutine psb_base_reallocate_nz(nz,a)
use psb_error_mod
implicit none
integer(psb_ipk_), intent(in) :: nz
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='reallocate_nz'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_reallocate_nz
subroutine psb_base_free(a)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='free'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
call psb_errpush(psb_err_missing_override_method_,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_base_free
subroutine psb_base_trim(a)
use psb_error_mod
implicit none
class(psb_base_sparse_mat), intent(inout) :: a
integer(psb_ipk_) :: err_act
character(len=20) :: name='trim'
logical, parameter :: debug=.false.
!
! This is the base version.
! The correct action is: do nothing.
! Indeed, the more complicated the data structure, the
! more likely this is the only possible course.
!
return
end subroutine psb_base_trim
end submodule psb_base_mat_impl_mod

3357
base/serial/impl/psb_d_base_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

6643
base/serial/impl/psb_d_coo_impl.f90
View File

File diff suppressed because it is too large Load Diff

5032
base/serial/impl/psb_d_csc_impl.f90
View File

File diff suppressed because it is too large Load Diff

102
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -2993,9 +2993,7 @@ contains
end subroutine psb_d_cp_csr_from_fmt
subroutine psb_dcsrspspmm(a,b,c,info)
use psb_d_mat_mod
use psb_serial_mod, psb_protect_name => psb_dcsrspspmm
use psb_error_mod
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a,b
@ -3114,56 +3112,56 @@ contains
end subroutine psb_dcsrspspmm
end submodule psb_d_csr_mat_impl
function psb_d_csr_maxval(a) result(res)
use psb_error_mod
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = dzero
nnz = a%get_nzeros()
if (allocated(a%val)) then
nnz = min(nnz,size(a%val))
res = maxval(abs(a%val(1:nnz)))
end if
end function psb_d_csr_maxval
function psb_d_csr_csnmi(a) result(res)
use psb_error_mod
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
function psb_d_csr_maxval(a) result(res)
use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_maxval
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = dzero
nnz = a%get_nzeros()
if (allocated(a%val)) then
nnz = min(nnz,size(a%val))
res = maxval(abs(a%val(1:nnz)))
end if
end function psb_d_csr_maxval
function psb_d_csr_csnmi(a) result(res)
use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_d_csr_csnmi
implicit none
class(psb_d_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc
real(psb_dpk_) :: acc
logical :: tra
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csnmi'
logical, parameter :: debug=.false.
res = dzero
if (a%is_dev()) call a%sync()
do i = 1, a%get_nrows()
acc = dzero
do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j))
integer(psb_ipk_) :: i,j,k,m,n, nr, ir, jc, nc
real(psb_dpk_) :: acc
logical :: tra
integer(psb_ipk_) :: err_act
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csnmi'
logical, parameter :: debug=.false.
res = dzero
if (a%is_dev()) call a%sync()
do i = 1, a%get_nrows()
acc = dzero
do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j))
end do
res = max(res,acc)
end do
res = max(res,acc)
end do
end function psb_d_csr_csnmi
end function psb_d_csr_csnmi
end submodule psb_d_csr_mat_impl

3613
base/serial/impl/psb_d_mat_impl.F90
View File

File diff suppressed because it is too large Load Diff

2272
base/serial/psi_serial_impl.f90
View File

File diff suppressed because it is too large Load Diff

1163
base/serial/sort/psb_d_hsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

528
base/serial/sort/psb_d_isort_impl.f90
Unescape Escape View File

@ -40,301 +40,295 @@
! Data Structures and Algorithms
! Addison-Wesley
!
subroutine psb_disort(x,ix,dir,flag)
use psb_d_sort_mod, psb_protect_name => psb_disort
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
submodule (psb_d_sort_mod) psb_d_isort_impl_mod
contains
subroutine psb_disort(x,ix,dir,flag)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
name='psb_disort'
call psb_erractionsave(err_act)
name='psb_disort'
call psb_erractionsave(err_act)
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(flag)) then
flag_ = flag
else
flag_ = psb_sort_ovw_idx_
end if
select case(flag_)
case( psb_sort_ovw_idx_, psb_sort_keep_idx_)
! OK keep going
case default
ierr(1) = 4; ierr(2) = flag_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
if (present(dir)) then
dir_ = dir
else
dir_= psb_sort_up_
end if
n = size(x)
n = size(x)
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
if (present(ix)) then
if (size(ix) < n) then
ierr(1) = 2; ierr(2) = size(ix);
call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr)
goto 9999
end if
if (flag_==psb_sort_ovw_idx_) then
do i=1,n
ix(i) = i
end do
end if
select case(dir_)
case (psb_sort_up_)
call psi_disrx_up(n,x,ix)
case (psb_sort_down_)
call psi_disrx_dw(n,x,ix)
case (psb_asort_up_)
select case(dir_)
case (psb_sort_up_)
call psi_disrx_up(n,x,ix)
case (psb_sort_down_)
call psi_disrx_dw(n,x,ix)
case (psb_asort_up_)
call psi_daisrx_up(n,x,ix)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_daisrx_dw(n,x,ix)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_disr_up(n,x)
case (psb_sort_down_)
call psi_disr_dw(n,x)
case (psb_asort_up_)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
else
select case(dir_)
case (psb_sort_up_)
call psi_disr_up(n,x)
case (psb_sort_down_)
call psi_disr_dw(n,x)
case (psb_asort_up_)
call psi_daisr_up(n,x)
case (psb_asort_down_)
case (psb_asort_down_)
call psi_daisr_dw(n,x)
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
case default
ierr(1) = 3; ierr(2) = dir_;
call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr)
goto 9999
end select
end if
end if
return
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_disort
return
end subroutine psb_disort
subroutine psi_disrx_up(n,x,idx)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_disrx_up
subroutine psi_disrx_dw(n,x,idx)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_disrx_dw
subroutine psi_disrx_up(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_disrx_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_disrx_up
subroutine psi_disr_up(n,x)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
subroutine psi_disrx_dw(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_disrx_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_disr_up
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_disrx_dw
subroutine psi_disr_dw(n,x)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_disr_dw
subroutine psi_disr_up(n,x)
use psb_d_sort_mod, psb_protect_name => psi_disr_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) < x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) >= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_disr_up
subroutine psi_daisrx_up(n,x,idx)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
subroutine psi_disr_dw(n,x)
use psb_d_sort_mod, psb_protect_name => psi_disr_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (x(j+1) > x(j)) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (x(i) <= xx) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_disr_dw
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_daisrx_up
subroutine psi_daisrx_up(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_daisrx_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
subroutine psi_daisrx_dw(n,x,idx)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_daisrx_up
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_daisrx_dw
subroutine psi_daisrx_dw(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_daisrx_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
subroutine psi_daisr_up(n,x)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
ix = idx(j)
i=j+1
do
x(i-1) = x(i)
idx(i-1) = idx(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
idx(i-1) = ix
endif
enddo
end subroutine psi_daisrx_dw
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_daisr_up
subroutine psi_daisr_up(n,x)
use psb_d_sort_mod, psb_protect_name => psi_daisr_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) < abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) >= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_daisr_up
subroutine psi_daisr_dw(n,x)
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
subroutine psi_daisr_dw(n,x)
use psb_d_sort_mod, psb_protect_name => psi_daisr_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j
real(psb_dpk_) :: xx
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_daisr_dw
do j=n-1,1,-1
if (abs(x(j+1)) > abs(x(j))) then
xx = x(j)
i=j+1
do
x(i-1) = x(i)
i = i+1
if (i>n) exit
if (abs(x(i)) <= abs(xx)) exit
end do
x(i-1) = xx
endif
enddo
end subroutine psi_daisr_dw
end submodule psb_d_isort_impl_mod

12
base/serial/sort/psb_d_msort_impl.f90
Unescape Escape View File

@ -40,9 +40,9 @@
! Data Structures and Algorithms
! Addison-Wesley
!
submodule (psb_d_sort_mod) psb_d_msort_impl_mod
contains
subroutine psb_dmsort(x,ix,dir,flag)
use psb_d_sort_mod, psb_protect_name => psb_dmsort
use psb_error_mod
use psb_ip_reord_mod
implicit none
@ -556,10 +556,4 @@
end subroutine psi_d_amsort_dw
end submodule psb_d_msort_impl_mod

2326
base/serial/sort/psb_d_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

46
prec/impl/psb_dilu_fct.f90
Unescape Escape View File

@ -69,7 +69,8 @@ subroutine psb_dilu_fct(a,l,u,d,info,blck)
endif
call psb_dilu_fctint(m,a%get_nrows(),a,blck_%get_nrows(),blck_,&
& d,l%val,l%ja,l%irp,u%val,u%ja,u%irp,l1,l2,info)
& d,l%get_valp(),l%get_jap(),l%get_irpp(),&
& u%get_valp(),u%get_jap(),u%get_irpp(),l1,l2,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_dilu_fctint'
@ -129,6 +130,8 @@ contains
real(psb_dpk_) :: dia,temp
integer(psb_ipk_), parameter :: nrb=60
type(psb_d_coo_sparse_mat) :: trw
real(psb_dpk_), pointer :: aval(:), bval(:)
integer(psb_ipk_), pointer :: airp(:), aja(:), birp(:), bja(:)
integer(psb_ipk_) :: int_err(5)
character(len=20) :: name, ch_err
@ -150,6 +153,27 @@ contains
l1=0
l2=0
m = ma+mb
select type(aa => a%a)
type is (psb_d_csr_sparse_mat)
aval => aa%get_valp()
airp => aa%get_irpp()
aja => aa%get_jap()
class default
aval => null()
airp => null()
aja => null()
end select
select type(bb => b%a)
type is (psb_d_csr_sparse_mat)
bval => bb%get_valp()
birp => bb%get_irpp()
bja => bb%get_jap()
class default
bval => null()
birp => null()
bja => null()
end select
do i = 1, ma
d(i) = dzero
@ -157,18 +181,18 @@ contains
!
select type(aa => a%a)
type is (psb_d_csr_sparse_mat)
do j = aa%irp(i), aa%irp(i+1) - 1
k = aa%ja(j)
do j = airp(i), airp(i+1) - 1
k = aja(j)
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)
laspk(l1) = aval(j)
lia1(l1) = k
else if (k == i) then
d(i) = aa%val(j)
d(i) = aval(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uaspk(l2) = aval(j)
uia1(l2) = k
end if
enddo
@ -295,18 +319,18 @@ contains
select type(aa => b%a)
type is (psb_d_csr_sparse_mat)
do j = aa%irp(i-ma), aa%irp(i-ma+1) - 1
k = aa%ja(j)
do j = birp(i-ma), birp(i-ma+1) - 1
k = bja(j)
! write(psb_err_unit,*)'KKKKK',k
if ((k < i).and.(k >= 1)) then
l1 = l1 + 1
laspk(l1) = aa%val(j)
laspk(l1) = bval(j)
lia1(l1) = k
else if (k == i) then
d(i) = aa%val(j)
d(i) = bval(j)
else if ((k > i).and.(k <= m)) then
l2 = l2 + 1
uaspk(l2) = aa%val(j)
uaspk(l2) = bval(j)
uia1(l2) = k
end if
enddo

4
test/pargen/runs/ppde.inp
Unescape Escape View File

@ -1,8 +1,8 @@
7 Number of entries below this
BICG STAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
BJAC Preconditioner NONE DIAG BJAC
CSR Storage format for matrix A: CSR COO JAD
100 Domain size (acutal system is this**3)
080 Domain size (acutal system is this**3)
2 Stopping criterion
1000 MAXIT
-1 ITRACE

22
util/psb_d_renum_impl.F90
Unescape Escape View File

@ -155,6 +155,8 @@ contains
type(psb_d_csr_sparse_mat) :: acsr
type(psb_d_coo_sparse_mat) :: acoo
integer(psb_ipk_), pointer :: airp(:), aja(:)
real(psb_dpk_), pointer :: aval(:)
integer(psb_ipk_) :: err_act
character(len=20) :: name
integer(psb_ipk_), allocatable :: ndstk(:,:), iold(:), ndeg(:), perm(:)
@ -171,9 +173,12 @@ contains
call aa%mv_to_fmt(acsr,info)
! Insert call to gps_reduce
nr = acsr%get_nrows()
airp => acsr%get_irpp()
aja => acsr%get_jap()
aval => acsr%get_valp()
ideg = 0
do i=1, nr
ideg = max(ideg,acsr%irp(i+1)-acsr%irp(i))
ideg = max(ideg,airp(i+1)-airp(i))
end do
allocate(ndstk(nr,ideg), iold(nr), perm(nr+1), ndeg(nr),stat=info)
if (info /= 0) then
@ -185,9 +190,9 @@ contains
iold(i) = i
ndstk(i,:) = 0
k = 0
do j=acsr%irp(i),acsr%irp(i+1)-1
do j=airp(i),airp(i+1)-1
k = k + 1
ndstk(i,k) = acsr%ja(j)
ndstk(i,k) = aja(j)
end do
end do
perm = 0
@ -347,6 +352,8 @@ subroutine psb_d_cmp_bwpf(mat,bwl,bwu,prf,info)
!
integer(psb_ipk_), allocatable :: irow(:), icol(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_ipk_), pointer :: airp(:), aja(:)
real(psb_dpk_), pointer :: aval(:)
integer(psb_ipk_) :: nz
integer(psb_ipk_) :: i, j, lrbu, lrbl
@ -356,12 +363,15 @@ subroutine psb_d_cmp_bwpf(mat,bwl,bwu,prf,info)
prf = 0
select type (aa=>mat%a)
class is (psb_d_csr_sparse_mat)
airp => aa%get_irpp()
aja => aa%get_jap()
aval => aa%get_valp()
do i=1, aa%get_nrows()
lrbl = 0
lrbu = 0
do j = aa%irp(i), aa%irp(i+1) - 1
lrbl = max(lrbl,i-aa%ja(j))
lrbu = max(lrbu,aa%ja(j)-i)
do j = airp(i), airp(i+1) - 1
lrbl = max(lrbl,i-aja(j))
lrbu = max(lrbu,aja(j)-i)
end do
prf = prf + lrbl+lrbu
bwu = max(bwu,lrbu)

12
util/psb_metispart_mod.F90
Unescape Escape View File

@ -159,9 +159,11 @@ contains
end if
end if
if (allocated(wgh_)) then
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts,wgh_)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),&
& aa%get_jap(),aa%get_irpp(),nparts,wgh_)
else
call build_mtpart(aa%get_nrows(),aa%get_fmt(),aa%ja,aa%irp,nparts)
call build_mtpart(aa%get_nrows(),aa%get_fmt(),&
& aa%get_jap(),aa%get_irpp(),nparts)
end if
class default
write(psb_err_unit,*) 'Sorry, right now we only take CSR input!'
@ -245,9 +247,11 @@ contains
end if
end if
if (allocated(wgh_)) then
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts,wgh_)
call build_mtpart(a%get_nrows(),a%get_fmt(),&
& a%get_jap(),a%get_irpp(),nparts,wgh_)
else
call build_mtpart(a%get_nrows(),a%get_fmt(),a%ja,a%irp,nparts)
call build_mtpart(a%get_nrows(),a%get_fmt(),&
& a%get_jap(),a%get_irpp(),nparts)
end if
end subroutine d_csr_build_mtpart

Write Preview
Loading…
Cancel
Save