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

Enlarge set of methods for LX.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 32ebf9efc0
commit 8aa7e04cc4
46 changed files with 7486 additions and 62 deletions
Show Stats Download Patch File Download Diff File

134
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -307,3 +307,137 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
return
end subroutine psb_lcsp_allgather
subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
type(psb_lcspmat_type), intent(inout) :: loca
type(psb_lcspmat_type), intent(inout) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_lc_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_lpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
name='psb_gather'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
if (present(keepnum)) then
keepnum_ = keepnum
else
keepnum_ = .true.
end if
if (present(keeploc)) then
keeploc_ = keeploc
else
keeploc_ = .true.
end if
call globa%free()
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
goto 9999
end if
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
info = -1
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(ione*ictxt,err_act)
return
end subroutine psb_lclcsp_allgather

134
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -307,3 +307,137 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
return
end subroutine psb_ldsp_allgather
subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
type(psb_ldspmat_type), intent(inout) :: loca
type(psb_ldspmat_type), intent(inout) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_ld_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_lpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
name='psb_gather'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
if (present(keepnum)) then
keepnum_ = keepnum
else
keepnum_ = .true.
end if
if (present(keeploc)) then
keeploc_ = keeploc
else
keeploc_ = .true.
end if
call globa%free()
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
goto 9999
end if
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
info = -1
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(ione*ictxt,err_act)
return
end subroutine psb_ldldsp_allgather

134
base/comm/psb_ispgather.F90
Unescape Escape View File

@ -307,3 +307,137 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
return
end subroutine psb_@LX@sp_allgather
subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
type(psb_@LX@spmat_type), intent(inout) :: loca
type(psb_@LX@spmat_type), intent(inout) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_lpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
name='psb_gather'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
if (present(keepnum)) then
keepnum_ = keepnum
else
keepnum_ = .true.
end if
if (present(keeploc)) then
keeploc_ = keeploc
else
keeploc_ = .true.
end if
call globa%free()
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_ipk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
goto 9999
end if
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
info = -1
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(ione*ictxt,err_act)
return
end subroutine psb_@LX@@LX@sp_allgather

134
base/comm/psb_lspgather.F90
Unescape Escape View File

@ -307,3 +307,137 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k
return
end subroutine psb_@LX@sp_allgather
subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
type(psb_@LX@spmat_type), intent(inout) :: loca
type(psb_@LX@spmat_type), intent(inout) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_lpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
name='psb_gather'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
if (present(keepnum)) then
keepnum_ = keepnum
else
keepnum_ = .true.
end if
if (present(keeploc)) then
keeploc_ = keeploc
else
keeploc_ = .true.
end if
call globa%free()
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
goto 9999
end if
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
info = -1
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(ione*ictxt,err_act)
return
end subroutine psb_@LX@@LX@sp_allgather

134
base/comm/psb_sspgather.F90
Unescape Escape View File

@ -307,3 +307,137 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
return
end subroutine psb_lssp_allgather
subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
type(psb_lsspmat_type), intent(inout) :: loca
type(psb_lsspmat_type), intent(inout) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_ls_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_lpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
name='psb_gather'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
if (present(keepnum)) then
keepnum_ = keepnum
else
keepnum_ = .true.
end if
if (present(keeploc)) then
keeploc_ = keeploc
else
keeploc_ = .true.
end if
call globa%free()
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_r_spk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
goto 9999
end if
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
info = -1
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(ione*ictxt,err_act)
return
end subroutine psb_lslssp_allgather

134
base/comm/psb_zspgather.F90
Unescape Escape View File

@ -307,3 +307,137 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee
return
end subroutine psb_lzsp_allgather
subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
use psb_desc_mod
use psb_error_mod
use psb_penv_mod
use psb_mat_mod
use psb_tools_mod
#ifdef MPI_MOD
use mpi
#endif
implicit none
#ifdef MPI_H
include 'mpif.h'
#endif
type(psb_lzspmat_type), intent(inout) :: loca
type(psb_lzspmat_type), intent(inout) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root, dupl
logical, intent(in), optional :: keepnum,keeploc
type(psb_lz_coo_sparse_mat) :: loc_coo, glob_coo
integer(psb_lpk_) :: nrg, ncg, nzg
integer(psb_ipk_) :: err_act, dupl_
integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl
logical :: keepnum_, keeploc_
integer(psb_mpk_) :: ictxt,np,me
integer(psb_mpk_) :: icomm, minfo, ndx
integer(psb_lpk_), allocatable :: nzbr(:), idisp(:)
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
integer(psb_ipk_) :: debug_level, debug_unit
name='psb_gather'
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_ ; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()
call psb_info(ictxt, me, np)
if (present(keepnum)) then
keepnum_ = keepnum
else
keepnum_ = .true.
end if
if (present(keeploc)) then
keeploc_ = keeploc
else
keeploc_ = .true.
end if
call globa%free()
if (keepnum_) then
nrg = desc_a%get_global_rows()
ncg = desc_a%get_global_rows()
allocate(nzbr(np), idisp(np),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
ierr(1) = 2*np
call psb_errpush(info,name,i_err=ierr,a_err='integer')
goto 9999
end if
if (keeploc_) then
call loca%cp_to(loc_coo)
else
call loca%mv_to(loc_coo)
end if
nzl = loc_coo%get_nzeros()
call psb_loc_to_glob(loc_coo%ia(1:nzl),desc_a,info,iact='I')
call psb_loc_to_glob(loc_coo%ja(1:nzl),desc_a,info,iact='I')
nzbr(:) = 0
nzbr(me+1) = nzl
call psb_sum(ictxt,nzbr(1:np))
nzg = sum(nzbr)
if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg)
if (info /= psb_success_) goto 9999
do ip=1,np
idisp(ip) = sum(nzbr(1:ip-1))
enddo
ndx = nzbr(me+1)
call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,&
& glob_coo%val,nzbr,idisp,&
& psb_mpi_c_dpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,&
& glob_coo%ia,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo == psb_success_) call &
& mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,&
& glob_coo%ja,nzbr,idisp,&
& psb_mpi_lpk_,icomm,minfo)
if (minfo /= psb_success_) then
info = minfo
call psb_errpush(psb_err_internal_error_,name,a_err=' from mpi_allgatherv')
goto 9999
end if
call loc_coo%free()
!
! Is the code below safe? For very large cases
! the indices in glob_coo will overflow. But then,
! for very large cases it does not make sense to
! gather the matrix on a single procecss anyway...
!
call glob_coo%set_nzeros(nzg)
if (present(dupl)) call glob_coo%set_dupl(dupl)
call globa%mv_from(glob_coo)
else
write(psb_err_unit,*) 'SP_ALLGATHER: Not implemented yet with keepnum ',keepnum_
info = -1
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_errpush(info,name)
call psb_error_handler(ione*ictxt,err_act)
return
end subroutine psb_lzlzsp_allgather

10
base/modules/comm/psb_c_comm_mod.f90
Unescape Escape View File

@ -115,6 +115,16 @@ module psb_c_comm_mod
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_lcsp_allgather
subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
import
implicit none
type(psb_lcspmat_type), intent(inout) :: loca
type(psb_lcspmat_type), intent(out) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_lclcsp_allgather
subroutine psb_cgather_vect(globx, locx, desc_a, info, root)
import
implicit none

10
base/modules/comm/psb_d_comm_mod.f90
Unescape Escape View File

@ -115,6 +115,16 @@ module psb_d_comm_mod
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_ldsp_allgather
subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
import
implicit none
type(psb_ldspmat_type), intent(inout) :: loca
type(psb_ldspmat_type), intent(out) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_ldldsp_allgather
subroutine psb_dgather_vect(globx, locx, desc_a, info, root)
import
implicit none

10
base/modules/comm/psb_s_comm_mod.f90
Unescape Escape View File

@ -115,6 +115,16 @@ module psb_s_comm_mod
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_lssp_allgather
subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
import
implicit none
type(psb_lsspmat_type), intent(inout) :: loca
type(psb_lsspmat_type), intent(out) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_lslssp_allgather
subroutine psb_sgather_vect(globx, locx, desc_a, info, root)
import
implicit none

10
base/modules/comm/psb_z_comm_mod.f90
Unescape Escape View File

@ -115,6 +115,16 @@ module psb_z_comm_mod
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_lzsp_allgather
subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc)
import
implicit none
type(psb_lzspmat_type), intent(inout) :: loca
type(psb_lzspmat_type), intent(out) :: globa
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in), optional :: root,dupl
logical, intent(in), optional :: keepnum,keeploc
end subroutine psb_lzlzsp_allgather
subroutine psb_zgather_vect(globx, locx, desc_a, info, root)
import
implicit none

212
base/modules/serial/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -276,9 +276,20 @@ module psb_c_base_mat_mod
procedure, pass(a) :: clone => psb_lc_base_clone
procedure, pass(a) :: make_nonunit => psb_lc_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lc_base_clean_zeros
procedure, pass(a) :: scals => psb_lc_base_scals
procedure, pass(a) :: scalv => psb_lc_base_scal
generic, public :: scal => scals, scalv
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_lc_base_scals
procedure, pass(a) :: scalv => psb_lc_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lc_base_maxval
procedure, pass(a) :: spnmi => psb_lc_base_csnmi
procedure, pass(a) :: spnm1 => psb_lc_base_csnm1
procedure, pass(a) :: rowsum => psb_lc_base_rowsum
procedure, pass(a) :: arwsum => psb_lc_base_arwsum
procedure, pass(a) :: colsum => psb_lc_base_colsum
procedure, pass(a) :: aclsum => psb_lc_base_aclsum
!
! Convert internal indices
!
@ -366,8 +377,19 @@ module psb_c_base_mat_mod
procedure, pass(a) :: set_by_cols => lc_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lc_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lc_coo_get_sort_status
procedure, pass(a) :: scals => psb_lc_coo_scals
procedure, pass(a) :: scalv => psb_lc_coo_scal
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_lc_coo_scals
procedure, pass(a) :: scalv => psb_lc_coo_scal
procedure, pass(a) :: maxval => psb_lc_coo_maxval
procedure, pass(a) :: spnmi => psb_lc_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lc_coo_csnm1
procedure, pass(a) :: rowsum => psb_lc_coo_rowsum
procedure, pass(a) :: arwsum => psb_lc_coo_arwsum
procedure, pass(a) :: colsum => psb_lc_coo_colsum
procedure, pass(a) :: aclsum => psb_lc_coo_aclsum
!
! This is COO specific
@ -2719,7 +2741,83 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_base_clean_zeros
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_maxval
interface
function psb_lc_coo_maxval(a) result(res)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_coo_maxval
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_csnmi
interface
function psb_lc_coo_csnmi(a) result(res)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_coo_csnmi
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_csnm1
interface
function psb_lc_coo_csnm1(a) result(res)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_coo_csnm1
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_rowsum
interface
subroutine psb_lc_coo_rowsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_rowsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_arwsum
interface
subroutine psb_lc_coo_arwsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_arwsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_colsum
interface
subroutine psb_lc_coo_colsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_colsum
end interface
!>
!! \memberof psb_lc_coo_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_aclsum
interface
subroutine psb_lc_coo_aclsum(d,a)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_coo_aclsum
end interface
!
!> Function base_scals:
!! \memberof psb_lc_base_sparse_mat
@ -2756,6 +2854,110 @@ module psb_c_base_mat_mod
end subroutine psb_lc_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_lc_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_lc_base_maxval(a) result(res)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lc_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_lc_base_csnmi(a) result(res)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lc_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_lc_base_csnm1(a) result(res)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_lc_base_rowsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_lc_base_arwsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_lc_base_colsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_lc_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_lc_base_aclsum(d,a)
import
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_base_aclsum
end interface
!
!> Function transp:

66
base/modules/serial/psb_c_csc_mat_mod.f90
Unescape Escape View File

@ -126,6 +126,12 @@ module psb_c_csc_mat_mod
procedure, pass(a) :: sizeof => lc_csc_sizeof
procedure, pass(a) :: scals => psb_lc_csc_scals
procedure, pass(a) :: scalv => psb_lc_csc_scal
procedure, pass(a) :: maxval => psb_lc_csc_maxval
procedure, pass(a) :: spnm1 => psb_lc_csc_csnm1
procedure, pass(a) :: rowsum => psb_lc_csc_rowsum
procedure, pass(a) :: arwsum => psb_lc_csc_arwsum
procedure, pass(a) :: colsum => psb_lc_csc_colsum
procedure, pass(a) :: aclsum => psb_lc_csc_aclsum
procedure, pass(a) :: reallocate_nz => psb_lc_csc_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lc_csc_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lc_cp_csc_to_coo
@ -796,6 +802,66 @@ module psb_c_csc_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csc_get_diag
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_maxval
interface
function psb_lc_csc_maxval(a) result(res)
import
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_csc_maxval
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_csnm1
interface
function psb_lc_csc_csnm1(a) result(res)
import
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_csc_csnm1
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_rowsum
interface
subroutine psb_lc_csc_rowsum(d,a)
import
class(psb_lc_csc_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csc_rowsum
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_arwsum
interface
subroutine psb_lc_csc_arwsum(d,a)
import
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csc_arwsum
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_colsum
interface
subroutine psb_lc_csc_colsum(d,a)
import
class(psb_lc_csc_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csc_colsum
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_aclsum
interface
subroutine psb_lc_csc_aclsum(d,a)
import
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csc_aclsum
end interface
!> \memberof psb_lc_csc_sparse_mat
!! \see psb_lc_base_mat_mod::psb_lc_base_scal

65
base/modules/serial/psb_c_csr_mat_mod.f90
Unescape Escape View File

@ -538,6 +538,12 @@ module psb_c_csr_mat_mod
procedure, pass(a) :: mold => psb_lc_csr_mold
procedure, pass(a) :: scals => psb_lc_csr_scals
procedure, pass(a) :: scalv => psb_lc_csr_scal
procedure, pass(a) :: maxval => psb_lc_csr_maxval
procedure, pass(a) :: spnmi => psb_lc_csr_csnmi
procedure, pass(a) :: rowsum => psb_lc_csr_rowsum
procedure, pass(a) :: arwsum => psb_lc_csr_arwsum
procedure, pass(a) :: colsum => psb_lc_csr_colsum
procedure, pass(a) :: aclsum => psb_lc_csr_aclsum
end type psb_lc_csr_sparse_mat
@ -821,8 +827,67 @@ module psb_c_csr_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_csr_scals
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_maxval
interface
function psb_lc_csr_maxval(a) result(res)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_csr_maxval
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_csnmi
interface
function psb_lc_csr_csnmi(a) result(res)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_csr_csnmi
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_rowsum
interface
subroutine psb_lc_csr_rowsum(d,a)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csr_rowsum
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_arwsum
interface
subroutine psb_lc_csr_arwsum(d,a)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csr_arwsum
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_colsum
interface
subroutine psb_lc_csr_colsum(d,a)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csr_colsum
end interface
!> \memberof psb_lc_csr_sparse_mat
!! \see psb_c_base_mat_mod::psb_lc_base_aclsum
interface
subroutine psb_lc_csr_aclsum(d,a)
import
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_lc_csr_aclsum
end interface
contains

65
base/modules/serial/psb_c_mat_mod.F90
Unescape Escape View File

@ -388,6 +388,13 @@ module psb_c_mat_mod
! Computational routines
procedure, pass(a) :: get_diag => psb_lc_get_diag
procedure, pass(a) :: maxval => psb_lc_maxval
procedure, pass(a) :: spnmi => psb_lc_csnmi
procedure, pass(a) :: spnm1 => psb_lc_csnm1
procedure, pass(a) :: rowsum => psb_lc_rowsum
procedure, pass(a) :: arwsum => psb_lc_arwsum
procedure, pass(a) :: colsum => psb_lc_colsum
procedure, pass(a) :: aclsum => psb_lc_aclsum
procedure, pass(a) :: scals => psb_lc_scals
procedure, pass(a) :: scalv => psb_lc_scal
generic, public :: scal => scals, scalv
@ -1679,14 +1686,68 @@ module psb_c_mat_mod
end subroutine psb_lc_scals
end interface
interface
function psb_lc_maxval(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_maxval
end interface
interface
function psb_lc_csnmi(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_csnmi
end interface
interface
function psb_lc_csnm1(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_) :: res
end function psb_lc_csnm1
end interface
interface
function psb_lc_rowsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
complex(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lc_rowsum
end interface
interface
function psb_lc_arwsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lc_arwsum
end interface
interface
function psb_lc_colsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
complex(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lc_colsum
end interface
interface
function psb_lc_aclsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type, psb_spk_
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lc_aclsum
end interface
contains
subroutine psb_c_set_mat_default(a)
implicit none
class(psb_c_base_sparse_mat), intent(in) :: a

212
base/modules/serial/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -276,9 +276,20 @@ module psb_d_base_mat_mod
procedure, pass(a) :: clone => psb_ld_base_clone
procedure, pass(a) :: make_nonunit => psb_ld_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ld_base_clean_zeros
procedure, pass(a) :: scals => psb_ld_base_scals
procedure, pass(a) :: scalv => psb_ld_base_scal
generic, public :: scal => scals, scalv
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_ld_base_scals
procedure, pass(a) :: scalv => psb_ld_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ld_base_maxval
procedure, pass(a) :: spnmi => psb_ld_base_csnmi
procedure, pass(a) :: spnm1 => psb_ld_base_csnm1
procedure, pass(a) :: rowsum => psb_ld_base_rowsum
procedure, pass(a) :: arwsum => psb_ld_base_arwsum
procedure, pass(a) :: colsum => psb_ld_base_colsum
procedure, pass(a) :: aclsum => psb_ld_base_aclsum
!
! Convert internal indices
!
@ -366,8 +377,19 @@ module psb_d_base_mat_mod
procedure, pass(a) :: set_by_cols => ld_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ld_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ld_coo_get_sort_status
procedure, pass(a) :: scals => psb_ld_coo_scals
procedure, pass(a) :: scalv => psb_ld_coo_scal
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_ld_coo_scals
procedure, pass(a) :: scalv => psb_ld_coo_scal
procedure, pass(a) :: maxval => psb_ld_coo_maxval
procedure, pass(a) :: spnmi => psb_ld_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ld_coo_csnm1
procedure, pass(a) :: rowsum => psb_ld_coo_rowsum
procedure, pass(a) :: arwsum => psb_ld_coo_arwsum
procedure, pass(a) :: colsum => psb_ld_coo_colsum
procedure, pass(a) :: aclsum => psb_ld_coo_aclsum
!
! This is COO specific
@ -2719,7 +2741,83 @@ module psb_d_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_base_clean_zeros
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_maxval
interface
function psb_ld_coo_maxval(a) result(res)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_coo_maxval
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_csnmi
interface
function psb_ld_coo_csnmi(a) result(res)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_coo_csnmi
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_csnm1
interface
function psb_ld_coo_csnm1(a) result(res)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_coo_csnm1
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_rowsum
interface
subroutine psb_ld_coo_rowsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_rowsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_arwsum
interface
subroutine psb_ld_coo_arwsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_arwsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_colsum
interface
subroutine psb_ld_coo_colsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_colsum
end interface
!>
!! \memberof psb_ld_coo_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_aclsum
interface
subroutine psb_ld_coo_aclsum(d,a)
import
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_coo_aclsum
end interface
!
!> Function base_scals:
!! \memberof psb_ld_base_sparse_mat
@ -2756,6 +2854,110 @@ module psb_d_base_mat_mod
end subroutine psb_ld_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_ld_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_ld_base_maxval(a) result(res)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ld_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_ld_base_csnmi(a) result(res)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ld_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_ld_base_csnm1(a) result(res)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_ld_base_rowsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_ld_base_arwsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_ld_base_colsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_ld_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_ld_base_aclsum(d,a)
import
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_base_aclsum
end interface
!
!> Function transp:

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

@ -126,6 +126,12 @@ module psb_d_csc_mat_mod
procedure, pass(a) :: sizeof => ld_csc_sizeof
procedure, pass(a) :: scals => psb_ld_csc_scals
procedure, pass(a) :: scalv => psb_ld_csc_scal
procedure, pass(a) :: maxval => psb_ld_csc_maxval
procedure, pass(a) :: spnm1 => psb_ld_csc_csnm1
procedure, pass(a) :: rowsum => psb_ld_csc_rowsum
procedure, pass(a) :: arwsum => psb_ld_csc_arwsum
procedure, pass(a) :: colsum => psb_ld_csc_colsum
procedure, pass(a) :: aclsum => psb_ld_csc_aclsum
procedure, pass(a) :: reallocate_nz => psb_ld_csc_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ld_csc_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ld_cp_csc_to_coo
@ -796,6 +802,66 @@ module psb_d_csc_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csc_get_diag
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_maxval
interface
function psb_ld_csc_maxval(a) result(res)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csc_maxval
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_csnm1
interface
function psb_ld_csc_csnm1(a) result(res)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csc_csnm1
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_rowsum
interface
subroutine psb_ld_csc_rowsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_rowsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_arwsum
interface
subroutine psb_ld_csc_arwsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_arwsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_colsum
interface
subroutine psb_ld_csc_colsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_colsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_aclsum
interface
subroutine psb_ld_csc_aclsum(d,a)
import
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csc_aclsum
end interface
!> \memberof psb_ld_csc_sparse_mat
!! \see psb_ld_base_mat_mod::psb_ld_base_scal

65
base/modules/serial/psb_d_csr_mat_mod.f90
Unescape Escape View File

@ -538,6 +538,12 @@ module psb_d_csr_mat_mod
procedure, pass(a) :: mold => psb_ld_csr_mold
procedure, pass(a) :: scals => psb_ld_csr_scals
procedure, pass(a) :: scalv => psb_ld_csr_scal
procedure, pass(a) :: maxval => psb_ld_csr_maxval
procedure, pass(a) :: spnmi => psb_ld_csr_csnmi
procedure, pass(a) :: rowsum => psb_ld_csr_rowsum
procedure, pass(a) :: arwsum => psb_ld_csr_arwsum
procedure, pass(a) :: colsum => psb_ld_csr_colsum
procedure, pass(a) :: aclsum => psb_ld_csr_aclsum
end type psb_ld_csr_sparse_mat
@ -821,8 +827,67 @@ module psb_d_csr_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ld_csr_scals
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_maxval
interface
function psb_ld_csr_maxval(a) result(res)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csr_maxval
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_csnmi
interface
function psb_ld_csr_csnmi(a) result(res)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csr_csnmi
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_rowsum
interface
subroutine psb_ld_csr_rowsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_rowsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_arwsum
interface
subroutine psb_ld_csr_arwsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_arwsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_colsum
interface
subroutine psb_ld_csr_colsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_colsum
end interface
!> \memberof psb_ld_csr_sparse_mat
!! \see psb_d_base_mat_mod::psb_ld_base_aclsum
interface
subroutine psb_ld_csr_aclsum(d,a)
import
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_ld_csr_aclsum
end interface
contains

65
base/modules/serial/psb_d_mat_mod.F90
Unescape Escape View File

@ -388,6 +388,13 @@ module psb_d_mat_mod
! Computational routines
procedure, pass(a) :: get_diag => psb_ld_get_diag
procedure, pass(a) :: maxval => psb_ld_maxval
procedure, pass(a) :: spnmi => psb_ld_csnmi
procedure, pass(a) :: spnm1 => psb_ld_csnm1
procedure, pass(a) :: rowsum => psb_ld_rowsum
procedure, pass(a) :: arwsum => psb_ld_arwsum
procedure, pass(a) :: colsum => psb_ld_colsum
procedure, pass(a) :: aclsum => psb_ld_aclsum
procedure, pass(a) :: scals => psb_ld_scals
procedure, pass(a) :: scalv => psb_ld_scal
generic, public :: scal => scals, scalv
@ -1679,14 +1686,68 @@ module psb_d_mat_mod
end subroutine psb_ld_scals
end interface
interface
function psb_ld_maxval(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_maxval
end interface
interface
function psb_ld_csnmi(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csnmi
end interface
interface
function psb_ld_csnm1(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_) :: res
end function psb_ld_csnm1
end interface
interface
function psb_ld_rowsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ld_rowsum
end interface
interface
function psb_ld_arwsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ld_arwsum
end interface
interface
function psb_ld_colsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ld_colsum
end interface
interface
function psb_ld_aclsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type, psb_dpk_
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ld_aclsum
end interface
contains
subroutine psb_d_set_mat_default(a)
implicit none
class(psb_d_base_sparse_mat), intent(in) :: a

212
base/modules/serial/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -276,9 +276,20 @@ module psb_s_base_mat_mod
procedure, pass(a) :: clone => psb_ls_base_clone
procedure, pass(a) :: make_nonunit => psb_ls_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_ls_base_clean_zeros
procedure, pass(a) :: scals => psb_ls_base_scals
procedure, pass(a) :: scalv => psb_ls_base_scal
generic, public :: scal => scals, scalv
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_ls_base_scals
procedure, pass(a) :: scalv => psb_ls_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_ls_base_maxval
procedure, pass(a) :: spnmi => psb_ls_base_csnmi
procedure, pass(a) :: spnm1 => psb_ls_base_csnm1
procedure, pass(a) :: rowsum => psb_ls_base_rowsum
procedure, pass(a) :: arwsum => psb_ls_base_arwsum
procedure, pass(a) :: colsum => psb_ls_base_colsum
procedure, pass(a) :: aclsum => psb_ls_base_aclsum
!
! Convert internal indices
!
@ -366,8 +377,19 @@ module psb_s_base_mat_mod
procedure, pass(a) :: set_by_cols => ls_coo_set_by_cols
procedure, pass(a) :: set_sort_status => ls_coo_set_sort_status
procedure, pass(a) :: get_sort_status => ls_coo_get_sort_status
procedure, pass(a) :: scals => psb_ls_coo_scals
procedure, pass(a) :: scalv => psb_ls_coo_scal
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_ls_coo_scals
procedure, pass(a) :: scalv => psb_ls_coo_scal
procedure, pass(a) :: maxval => psb_ls_coo_maxval
procedure, pass(a) :: spnmi => psb_ls_coo_csnmi
procedure, pass(a) :: spnm1 => psb_ls_coo_csnm1
procedure, pass(a) :: rowsum => psb_ls_coo_rowsum
procedure, pass(a) :: arwsum => psb_ls_coo_arwsum
procedure, pass(a) :: colsum => psb_ls_coo_colsum
procedure, pass(a) :: aclsum => psb_ls_coo_aclsum
!
! This is COO specific
@ -2719,7 +2741,83 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_base_clean_zeros
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_maxval
interface
function psb_ls_coo_maxval(a) result(res)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_coo_maxval
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_csnmi
interface
function psb_ls_coo_csnmi(a) result(res)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_coo_csnmi
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_csnm1
interface
function psb_ls_coo_csnm1(a) result(res)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_coo_csnm1
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_rowsum
interface
subroutine psb_ls_coo_rowsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_rowsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_arwsum
interface
subroutine psb_ls_coo_arwsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_arwsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_colsum
interface
subroutine psb_ls_coo_colsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_colsum
end interface
!>
!! \memberof psb_ls_coo_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_aclsum
interface
subroutine psb_ls_coo_aclsum(d,a)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_coo_aclsum
end interface
!
!> Function base_scals:
!! \memberof psb_ls_base_sparse_mat
@ -2756,6 +2854,110 @@ module psb_s_base_mat_mod
end subroutine psb_ls_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_ls_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_ls_base_maxval(a) result(res)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ls_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_ls_base_csnmi(a) result(res)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_ls_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_ls_base_csnm1(a) result(res)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_ls_base_rowsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_ls_base_arwsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_ls_base_colsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_ls_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_ls_base_aclsum(d,a)
import
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_base_aclsum
end interface
!
!> Function transp:

66
base/modules/serial/psb_s_csc_mat_mod.f90
Unescape Escape View File

@ -126,6 +126,12 @@ module psb_s_csc_mat_mod
procedure, pass(a) :: sizeof => ls_csc_sizeof
procedure, pass(a) :: scals => psb_ls_csc_scals
procedure, pass(a) :: scalv => psb_ls_csc_scal
procedure, pass(a) :: maxval => psb_ls_csc_maxval
procedure, pass(a) :: spnm1 => psb_ls_csc_csnm1
procedure, pass(a) :: rowsum => psb_ls_csc_rowsum
procedure, pass(a) :: arwsum => psb_ls_csc_arwsum
procedure, pass(a) :: colsum => psb_ls_csc_colsum
procedure, pass(a) :: aclsum => psb_ls_csc_aclsum
procedure, pass(a) :: reallocate_nz => psb_ls_csc_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_ls_csc_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_ls_cp_csc_to_coo
@ -796,6 +802,66 @@ module psb_s_csc_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csc_get_diag
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_maxval
interface
function psb_ls_csc_maxval(a) result(res)
import
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_csc_maxval
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_csnm1
interface
function psb_ls_csc_csnm1(a) result(res)
import
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_csc_csnm1
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_rowsum
interface
subroutine psb_ls_csc_rowsum(d,a)
import
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csc_rowsum
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_arwsum
interface
subroutine psb_ls_csc_arwsum(d,a)
import
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csc_arwsum
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_colsum
interface
subroutine psb_ls_csc_colsum(d,a)
import
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csc_colsum
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_aclsum
interface
subroutine psb_ls_csc_aclsum(d,a)
import
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csc_aclsum
end interface
!> \memberof psb_ls_csc_sparse_mat
!! \see psb_ls_base_mat_mod::psb_ls_base_scal

65
base/modules/serial/psb_s_csr_mat_mod.f90
Unescape Escape View File

@ -538,6 +538,12 @@ module psb_s_csr_mat_mod
procedure, pass(a) :: mold => psb_ls_csr_mold
procedure, pass(a) :: scals => psb_ls_csr_scals
procedure, pass(a) :: scalv => psb_ls_csr_scal
procedure, pass(a) :: maxval => psb_ls_csr_maxval
procedure, pass(a) :: spnmi => psb_ls_csr_csnmi
procedure, pass(a) :: rowsum => psb_ls_csr_rowsum
procedure, pass(a) :: arwsum => psb_ls_csr_arwsum
procedure, pass(a) :: colsum => psb_ls_csr_colsum
procedure, pass(a) :: aclsum => psb_ls_csr_aclsum
end type psb_ls_csr_sparse_mat
@ -821,8 +827,67 @@ module psb_s_csr_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_csr_scals
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_maxval
interface
function psb_ls_csr_maxval(a) result(res)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_csr_maxval
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_csnmi
interface
function psb_ls_csr_csnmi(a) result(res)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_csr_csnmi
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_rowsum
interface
subroutine psb_ls_csr_rowsum(d,a)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csr_rowsum
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_arwsum
interface
subroutine psb_ls_csr_arwsum(d,a)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csr_arwsum
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_colsum
interface
subroutine psb_ls_csr_colsum(d,a)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csr_colsum
end interface
!> \memberof psb_ls_csr_sparse_mat
!! \see psb_s_base_mat_mod::psb_ls_base_aclsum
interface
subroutine psb_ls_csr_aclsum(d,a)
import
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
end subroutine psb_ls_csr_aclsum
end interface
contains

65
base/modules/serial/psb_s_mat_mod.F90
Unescape Escape View File

@ -388,6 +388,13 @@ module psb_s_mat_mod
! Computational routines
procedure, pass(a) :: get_diag => psb_ls_get_diag
procedure, pass(a) :: maxval => psb_ls_maxval
procedure, pass(a) :: spnmi => psb_ls_csnmi
procedure, pass(a) :: spnm1 => psb_ls_csnm1
procedure, pass(a) :: rowsum => psb_ls_rowsum
procedure, pass(a) :: arwsum => psb_ls_arwsum
procedure, pass(a) :: colsum => psb_ls_colsum
procedure, pass(a) :: aclsum => psb_ls_aclsum
procedure, pass(a) :: scals => psb_ls_scals
procedure, pass(a) :: scalv => psb_ls_scal
generic, public :: scal => scals, scalv
@ -1679,14 +1686,68 @@ module psb_s_mat_mod
end subroutine psb_ls_scals
end interface
interface
function psb_ls_maxval(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_maxval
end interface
interface
function psb_ls_csnmi(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_csnmi
end interface
interface
function psb_ls_csnm1(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_) :: res
end function psb_ls_csnm1
end interface
interface
function psb_ls_rowsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ls_rowsum
end interface
interface
function psb_ls_arwsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ls_arwsum
end interface
interface
function psb_ls_colsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ls_colsum
end interface
interface
function psb_ls_aclsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type, psb_spk_
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_ls_aclsum
end interface
contains
subroutine psb_s_set_mat_default(a)
implicit none
class(psb_s_base_sparse_mat), intent(in) :: a

212
base/modules/serial/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -276,9 +276,20 @@ module psb_z_base_mat_mod
procedure, pass(a) :: clone => psb_lz_base_clone
procedure, pass(a) :: make_nonunit => psb_lz_base_make_nonunit
procedure, pass(a) :: clean_zeros => psb_lz_base_clean_zeros
procedure, pass(a) :: scals => psb_lz_base_scals
procedure, pass(a) :: scalv => psb_lz_base_scal
generic, public :: scal => scals, scalv
!
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_lz_base_scals
procedure, pass(a) :: scalv => psb_lz_base_scal
generic, public :: scal => scals, scalv
procedure, pass(a) :: maxval => psb_lz_base_maxval
procedure, pass(a) :: spnmi => psb_lz_base_csnmi
procedure, pass(a) :: spnm1 => psb_lz_base_csnm1
procedure, pass(a) :: rowsum => psb_lz_base_rowsum
procedure, pass(a) :: arwsum => psb_lz_base_arwsum
procedure, pass(a) :: colsum => psb_lz_base_colsum
procedure, pass(a) :: aclsum => psb_lz_base_aclsum
!
! Convert internal indices
!
@ -366,8 +377,19 @@ module psb_z_base_mat_mod
procedure, pass(a) :: set_by_cols => lz_coo_set_by_cols
procedure, pass(a) :: set_sort_status => lz_coo_set_sort_status
procedure, pass(a) :: get_sort_status => lz_coo_get_sort_status
procedure, pass(a) :: scals => psb_lz_coo_scals
procedure, pass(a) :: scalv => psb_lz_coo_scal
! Computational methods: defined here but not implemented.
!
procedure, pass(a) :: scals => psb_lz_coo_scals
procedure, pass(a) :: scalv => psb_lz_coo_scal
procedure, pass(a) :: maxval => psb_lz_coo_maxval
procedure, pass(a) :: spnmi => psb_lz_coo_csnmi
procedure, pass(a) :: spnm1 => psb_lz_coo_csnm1
procedure, pass(a) :: rowsum => psb_lz_coo_rowsum
procedure, pass(a) :: arwsum => psb_lz_coo_arwsum
procedure, pass(a) :: colsum => psb_lz_coo_colsum
procedure, pass(a) :: aclsum => psb_lz_coo_aclsum
!
! This is COO specific
@ -2719,7 +2741,83 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_base_clean_zeros
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_maxval
interface
function psb_lz_coo_maxval(a) result(res)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_coo_maxval
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_csnmi
interface
function psb_lz_coo_csnmi(a) result(res)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_coo_csnmi
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_csnm1
interface
function psb_lz_coo_csnm1(a) result(res)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_coo_csnm1
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_rowsum
interface
subroutine psb_lz_coo_rowsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_rowsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_arwsum
interface
subroutine psb_lz_coo_arwsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_arwsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_colsum
interface
subroutine psb_lz_coo_colsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_colsum
end interface
!>
!! \memberof psb_lz_coo_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_aclsum
interface
subroutine psb_lz_coo_aclsum(d,a)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_coo_aclsum
end interface
!
!> Function base_scals:
!! \memberof psb_lz_base_sparse_mat
@ -2756,6 +2854,110 @@ module psb_z_base_mat_mod
end subroutine psb_lz_base_scal
end interface
!
!> Function base_maxval:
!! \memberof psb_lz_base_sparse_mat
!! \brief Maximum absolute value of all coefficients;
!!
!
interface
function psb_lz_base_maxval(a) result(res)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_base_maxval
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lz_base_sparse_mat
!! \brief Operator infinity norm
!!
!
interface
function psb_lz_base_csnmi(a) result(res)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_base_csnmi
end interface
!
!
!> Function base_csnmi:
!! \memberof psb_lz_base_sparse_mat
!! \brief Operator 1-norm
!!
!
interface
function psb_lz_base_csnm1(a) result(res)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_base_csnm1
end interface
!
!
!> Function base_rowsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Sum along the rows
!! \param d(:) The output row sums
!!
!
interface
subroutine psb_lz_base_rowsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_rowsum
end interface
!
!> Function base_arwsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Absolute value sum along the rows
!! \param d(:) The output row sums
!!
interface
subroutine psb_lz_base_arwsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_arwsum
end interface
!
!
!> Function base_colsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Sum along the columns
!! \param d(:) The output col sums
!!
!
interface
subroutine psb_lz_base_colsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_colsum
end interface
!
!> Function base_aclsum:
!! \memberof psb_lz_base_sparse_mat
!! \brief Absolute value sum along the columns
!! \param d(:) The output col sums
!!
interface
subroutine psb_lz_base_aclsum(d,a)
import
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_base_aclsum
end interface
!
!> Function transp:

66
base/modules/serial/psb_z_csc_mat_mod.f90
Unescape Escape View File

@ -126,6 +126,12 @@ module psb_z_csc_mat_mod
procedure, pass(a) :: sizeof => lz_csc_sizeof
procedure, pass(a) :: scals => psb_lz_csc_scals
procedure, pass(a) :: scalv => psb_lz_csc_scal
procedure, pass(a) :: maxval => psb_lz_csc_maxval
procedure, pass(a) :: spnm1 => psb_lz_csc_csnm1
procedure, pass(a) :: rowsum => psb_lz_csc_rowsum
procedure, pass(a) :: arwsum => psb_lz_csc_arwsum
procedure, pass(a) :: colsum => psb_lz_csc_colsum
procedure, pass(a) :: aclsum => psb_lz_csc_aclsum
procedure, pass(a) :: reallocate_nz => psb_lz_csc_reallocate_nz
procedure, pass(a) :: allocate_mnnz => psb_lz_csc_allocate_mnnz
procedure, pass(a) :: cp_to_coo => psb_lz_cp_csc_to_coo
@ -796,6 +802,66 @@ module psb_z_csc_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csc_get_diag
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_maxval
interface
function psb_lz_csc_maxval(a) result(res)
import
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_csc_maxval
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_csnm1
interface
function psb_lz_csc_csnm1(a) result(res)
import
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_csc_csnm1
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_rowsum
interface
subroutine psb_lz_csc_rowsum(d,a)
import
class(psb_lz_csc_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csc_rowsum
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_arwsum
interface
subroutine psb_lz_csc_arwsum(d,a)
import
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csc_arwsum
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_colsum
interface
subroutine psb_lz_csc_colsum(d,a)
import
class(psb_lz_csc_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csc_colsum
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_aclsum
interface
subroutine psb_lz_csc_aclsum(d,a)
import
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csc_aclsum
end interface
!> \memberof psb_lz_csc_sparse_mat
!! \see psb_lz_base_mat_mod::psb_lz_base_scal

65
base/modules/serial/psb_z_csr_mat_mod.f90
Unescape Escape View File

@ -538,6 +538,12 @@ module psb_z_csr_mat_mod
procedure, pass(a) :: mold => psb_lz_csr_mold
procedure, pass(a) :: scals => psb_lz_csr_scals
procedure, pass(a) :: scalv => psb_lz_csr_scal
procedure, pass(a) :: maxval => psb_lz_csr_maxval
procedure, pass(a) :: spnmi => psb_lz_csr_csnmi
procedure, pass(a) :: rowsum => psb_lz_csr_rowsum
procedure, pass(a) :: arwsum => psb_lz_csr_arwsum
procedure, pass(a) :: colsum => psb_lz_csr_colsum
procedure, pass(a) :: aclsum => psb_lz_csr_aclsum
end type psb_lz_csr_sparse_mat
@ -821,8 +827,67 @@ module psb_z_csr_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_csr_scals
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_maxval
interface
function psb_lz_csr_maxval(a) result(res)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_csr_maxval
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_csnmi
interface
function psb_lz_csr_csnmi(a) result(res)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_csr_csnmi
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_rowsum
interface
subroutine psb_lz_csr_rowsum(d,a)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csr_rowsum
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_arwsum
interface
subroutine psb_lz_csr_arwsum(d,a)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csr_arwsum
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_colsum
interface
subroutine psb_lz_csr_colsum(d,a)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csr_colsum
end interface
!> \memberof psb_lz_csr_sparse_mat
!! \see psb_z_base_mat_mod::psb_lz_base_aclsum
interface
subroutine psb_lz_csr_aclsum(d,a)
import
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
end subroutine psb_lz_csr_aclsum
end interface
contains

65
base/modules/serial/psb_z_mat_mod.F90
Unescape Escape View File

@ -388,6 +388,13 @@ module psb_z_mat_mod
! Computational routines
procedure, pass(a) :: get_diag => psb_lz_get_diag
procedure, pass(a) :: maxval => psb_lz_maxval
procedure, pass(a) :: spnmi => psb_lz_csnmi
procedure, pass(a) :: spnm1 => psb_lz_csnm1
procedure, pass(a) :: rowsum => psb_lz_rowsum
procedure, pass(a) :: arwsum => psb_lz_arwsum
procedure, pass(a) :: colsum => psb_lz_colsum
procedure, pass(a) :: aclsum => psb_lz_aclsum
procedure, pass(a) :: scals => psb_lz_scals
procedure, pass(a) :: scalv => psb_lz_scal
generic, public :: scal => scals, scalv
@ -1679,14 +1686,68 @@ module psb_z_mat_mod
end subroutine psb_lz_scals
end interface
interface
function psb_lz_maxval(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_maxval
end interface
interface
function psb_lz_csnmi(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_csnmi
end interface
interface
function psb_lz_csnm1(a) result(res)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_) :: res
end function psb_lz_csnm1
end interface
interface
function psb_lz_rowsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
complex(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lz_rowsum
end interface
interface
function psb_lz_arwsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lz_arwsum
end interface
interface
function psb_lz_colsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
complex(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lz_colsum
end interface
interface
function psb_lz_aclsum(a,info) result(d)
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type, psb_dpk_
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
end function psb_lz_aclsum
end interface
contains
subroutine psb_z_set_mat_default(a)
implicit none
class(psb_z_base_sparse_mat), intent(in) :: a

191
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -1578,8 +1578,6 @@ subroutine psb_c_base_scal(d,a,info,side)
end subroutine psb_c_base_scal
function psb_c_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1770,7 +1768,6 @@ subroutine psb_c_base_aclsum(d,a)
end subroutine psb_c_base_aclsum
subroutine psb_c_base_get_diag(a,d,info)
use psb_error_mod
use psb_const_mod
@ -3434,8 +3431,6 @@ subroutine psb_lc_base_scals(d,a,info)
end subroutine psb_lc_base_scals
subroutine psb_lc_base_scal(d,a,info,side)
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_scal
use psb_error_mod
@ -3460,6 +3455,192 @@ subroutine psb_lc_base_scal(d,a,info,side)
end subroutine psb_lc_base_scal
function psb_lc_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_maxval
implicit none
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = szero
! 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 function psb_lc_base_maxval
function psb_lc_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_csnmi
implicit none
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_base_csnmi
function psb_lc_base_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_csnm1
implicit none
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_base_csnm1
subroutine psb_lc_base_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_rowsum
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lc_base_rowsum
subroutine psb_lc_base_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_arwsum
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lc_base_arwsum
subroutine psb_lc_base_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_colsum
class(psb_lc_base_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lc_base_colsum
subroutine psb_lc_base_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_base_aclsum
class(psb_lc_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lc_base_aclsum
subroutine psb_lc_base_get_diag(a,d,info)
use psb_error_mod

321
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -29,7 +29,6 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_c_coo_get_diag(a,d,info)
use psb_c_base_mat_mod, psb_protect_name => psb_c_coo_get_diag
use psb_error_mod
@ -1936,7 +1935,6 @@ subroutine psb_c_coo_aclsum(d,a)
end subroutine psb_c_coo_aclsum
! == ==================================
!
!
@ -4159,7 +4157,6 @@ subroutine psb_lc_coo_get_diag(a,d,info)
end subroutine psb_lc_coo_get_diag
subroutine psb_lc_coo_scal(d,a,info,side)
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_scal
use psb_error_mod
@ -4267,6 +4264,324 @@ subroutine psb_lc_coo_scals(d,a,info)
end subroutine psb_lc_coo_scals
function psb_lc_coo_maxval(a) result(res)
use psb_error_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_maxval
implicit none
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
character(len=20) :: name='c_coo_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
res = sone
else
res = szero
end if
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_lc_coo_maxval
function psb_lc_coo_csnmi(a) result(res)
use psb_error_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_csnmi
implicit none
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_coo_csnmi'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = szero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_by_rows()) then
i = 1
j = i
res = szero
do while (i<=nnz)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1
enddo
if (is_unit) then
acc = sone
else
acc = szero
end if
do k=i, j-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
i = j
end do
else
m = a%get_nrows()
allocate(vt(m),stat=info)
if (info /= 0) return
if (is_unit) then
vt = sone
else
vt = szero
end if
do j=1, nnz
i = a%ia(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:m))
deallocate(vt,stat=info)
end if
end function psb_lc_coo_csnmi
function psb_lc_coo_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_csnm1
implicit none
class(psb_c_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='lc_coo_csnm1'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = szero
nnz = a%get_nzeros()
n = a%get_ncols()
allocate(vt(n),stat=info)
if (info /= 0) return
if (a%is_unit()) then
vt = sone
else
vt = szero
end if
do j=1, nnz
i = a%ja(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:n))
deallocate(vt,stat=info)
return
end function psb_lc_coo_csnm1
subroutine psb_lc_coo_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_rowsum
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = cone
else
d = czero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_coo_rowsum
subroutine psb_lc_coo_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_arwsum
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_coo_arwsum
subroutine psb_lc_coo_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_colsum
class(psb_lc_coo_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = cone
else
d = czero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_coo_colsum
subroutine psb_lc_coo_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_aclsum
class(psb_lc_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_coo_aclsum
subroutine psb_lc_coo_reallocate_nz(nz,a)
use psb_c_base_mat_mod, psb_protect_name => psb_lc_coo_reallocate_nz
use psb_error_mod

273
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -3116,6 +3116,279 @@ subroutine psb_lc_csc_scals(d,a,info)
end subroutine psb_lc_csc_scals
function psb_lc_csc_maxval(a) result(res)
use psb_error_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_maxval
implicit none
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: nnz
character(len=20) :: name='lc_csc_maxval'
logical, parameter :: debug=.false.
if (a%is_unit()) then
res = sone
else
res = szero
end if
if (a%is_dev()) call a%sync()
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_lc_csc_maxval
function psb_lc_csc_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_csnm1
implicit none
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='lc_csc_csnm1'
logical, parameter :: debug=.false.
res = szero
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n
if (is_unit) then
acc = sone
else
acc = szero
end if
do k=a%icp(j),a%icp(j+1)-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
end do
return
end function psb_lc_csc_csnm1
subroutine psb_lc_csc_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_colsum
class(psb_lc_csc_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = cone
else
d(i) = czero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csc_colsum
subroutine psb_lc_csc_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_aclsum
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_lpk_) :: m,n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = sone
else
d(i) = szero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, a%get_ncols()
d(i) = d(i) + sone
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csc_aclsum
subroutine psb_lc_csc_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_rowsum
class(psb_lc_csc_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = cone
else
d = czero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + (a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csc_rowsum
subroutine psb_lc_csc_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csc_mat_mod, psb_protect_name => psb_lc_csc_arwsum
class(psb_lc_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + abs(a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csc_arwsum
! == ===================================
!
!

257
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -1302,7 +1302,7 @@ function psb_c_csr_csnmi(a) result(res)
if (a%is_dev()) call a%sync()
do i = 1, a%get_nrows()
acc = dzero
acc = szero
do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j))
end do
@ -3333,6 +3333,261 @@ subroutine psb_lc_csr_scals(d,a,info)
end subroutine psb_lc_csr_scals
function psb_lc_csr_maxval(a) result(res)
use psb_error_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_maxval
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: nnz
integer(psb_ipk_) :: info
character(len=20) :: name='lc_csr_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = szero
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_lc_csr_maxval
function psb_lc_csr_csnmi(a) result(res)
use psb_error_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_csnmi
implicit none
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nr, ir, jc, nc
real(psb_spk_) :: acc
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='lc_csnmi'
logical, parameter :: debug=.false.
res = szero
if (a%is_dev()) call a%sync()
do i = 1, a%get_nrows()
acc = szero
do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j))
end do
res = max(res,acc)
end do
end function psb_lc_csr_csnmi
subroutine psb_lc_csr_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_rowsum
class(psb_lc_csr_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = czero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + cone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csr_rowsum
subroutine psb_lc_csr_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_arwsum
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = szero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + sone
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csr_arwsum
subroutine psb_lc_csr_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_colsum
class(psb_lc_csr_sparse_mat), intent(in) :: a
complex(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
complex(psb_spk_) :: acc
complex(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = czero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + cone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csr_colsum
subroutine psb_lc_csr_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_c_csr_mat_mod, psb_protect_name => psb_lc_csr_aclsum
class(psb_lc_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = szero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + sone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lc_csr_aclsum
! == ===================================

227
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -4480,6 +4480,233 @@ subroutine psb_lc_scals(d,a,info)
end subroutine psb_lc_scals
function psb_lc_maxval(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_lc_maxval
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%maxval()
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_maxval
function psb_lc_csnmi(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_lc_csnmi
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnmi()
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_csnmi
function psb_lc_csnm1(a) result(res)
use psb_c_mat_mod, psb_protect_name => psb_lc_csnm1
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnm1()
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_csnm1
function psb_lc_rowsum(a,info) result(d)
use psb_c_mat_mod, psb_protect_name => psb_lc_rowsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
complex(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_rowsum
function psb_lc_arwsum(a,info) result(d)
use psb_c_mat_mod, psb_protect_name => psb_lc_arwsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_arwsum
function psb_lc_colsum(a,info) result(d)
use psb_c_mat_mod, psb_protect_name => psb_lc_colsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
complex(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_colsum
function psb_lc_aclsum(a,info) result(d)
use psb_c_mat_mod, psb_protect_name => psb_lc_aclsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lcspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lc_aclsum
subroutine psb_lc_mv_from_ib(a,b)
use psb_error_mod
use psb_const_mod

191
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -1578,8 +1578,6 @@ subroutine psb_d_base_scal(d,a,info,side)
end subroutine psb_d_base_scal
function psb_d_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1770,7 +1768,6 @@ subroutine psb_d_base_aclsum(d,a)
end subroutine psb_d_base_aclsum
subroutine psb_d_base_get_diag(a,d,info)
use psb_error_mod
use psb_const_mod
@ -3434,8 +3431,6 @@ subroutine psb_ld_base_scals(d,a,info)
end subroutine psb_ld_base_scals
subroutine psb_ld_base_scal(d,a,info,side)
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_scal
use psb_error_mod
@ -3460,6 +3455,192 @@ subroutine psb_ld_base_scal(d,a,info,side)
end subroutine psb_ld_base_scal
function psb_ld_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_maxval
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = dzero
! 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 function psb_ld_base_maxval
function psb_ld_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_csnmi
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_base_csnmi
function psb_ld_base_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_csnm1
implicit none
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_base_csnm1
subroutine psb_ld_base_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_rowsum
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ld_base_rowsum
subroutine psb_ld_base_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_arwsum
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ld_base_arwsum
subroutine psb_ld_base_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_colsum
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ld_base_colsum
subroutine psb_ld_base_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_base_aclsum
class(psb_ld_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ld_base_aclsum
subroutine psb_ld_base_get_diag(a,d,info)
use psb_error_mod

321
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -29,7 +29,6 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_d_coo_get_diag(a,d,info)
use psb_d_base_mat_mod, psb_protect_name => psb_d_coo_get_diag
use psb_error_mod
@ -1936,7 +1935,6 @@ subroutine psb_d_coo_aclsum(d,a)
end subroutine psb_d_coo_aclsum
! == ==================================
!
!
@ -4159,7 +4157,6 @@ subroutine psb_ld_coo_get_diag(a,d,info)
end subroutine psb_ld_coo_get_diag
subroutine psb_ld_coo_scal(d,a,info,side)
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_scal
use psb_error_mod
@ -4267,6 +4264,324 @@ subroutine psb_ld_coo_scals(d,a,info)
end subroutine psb_ld_coo_scals
function psb_ld_coo_maxval(a) result(res)
use psb_error_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_maxval
implicit none
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
character(len=20) :: name='d_coo_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
res = done
else
res = dzero
end if
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_ld_coo_maxval
function psb_ld_coo_csnmi(a) result(res)
use psb_error_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_csnmi
implicit none
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_coo_csnmi'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = dzero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_by_rows()) then
i = 1
j = i
res = dzero
do while (i<=nnz)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1
enddo
if (is_unit) then
acc = done
else
acc = dzero
end if
do k=i, j-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
i = j
end do
else
m = a%get_nrows()
allocate(vt(m),stat=info)
if (info /= 0) return
if (is_unit) then
vt = done
else
vt = dzero
end if
do j=1, nnz
i = a%ia(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:m))
deallocate(vt,stat=info)
end if
end function psb_ld_coo_csnmi
function psb_ld_coo_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_csnm1
implicit none
class(psb_d_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='ld_coo_csnm1'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = dzero
nnz = a%get_nzeros()
n = a%get_ncols()
allocate(vt(n),stat=info)
if (info /= 0) return
if (a%is_unit()) then
vt = done
else
vt = dzero
end if
do j=1, nnz
i = a%ja(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:n))
deallocate(vt,stat=info)
return
end function psb_ld_coo_csnm1
subroutine psb_ld_coo_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_rowsum
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_coo_rowsum
subroutine psb_ld_coo_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_arwsum
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_coo_arwsum
subroutine psb_ld_coo_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_colsum
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_coo_colsum
subroutine psb_ld_coo_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_aclsum
class(psb_ld_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_coo_aclsum
subroutine psb_ld_coo_reallocate_nz(nz,a)
use psb_d_base_mat_mod, psb_protect_name => psb_ld_coo_reallocate_nz
use psb_error_mod

273
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -3116,6 +3116,279 @@ subroutine psb_ld_csc_scals(d,a,info)
end subroutine psb_ld_csc_scals
function psb_ld_csc_maxval(a) result(res)
use psb_error_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_maxval
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: nnz
character(len=20) :: name='ld_csc_maxval'
logical, parameter :: debug=.false.
if (a%is_unit()) then
res = done
else
res = dzero
end if
if (a%is_dev()) call a%sync()
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_ld_csc_maxval
function psb_ld_csc_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_csnm1
implicit none
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='ld_csc_csnm1'
logical, parameter :: debug=.false.
res = dzero
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n
if (is_unit) then
acc = done
else
acc = dzero
end if
do k=a%icp(j),a%icp(j+1)-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
end do
return
end function psb_ld_csc_csnm1
subroutine psb_ld_csc_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_colsum
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = done
else
d(i) = dzero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csc_colsum
subroutine psb_ld_csc_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_aclsum
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_lpk_) :: m,n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = done
else
d(i) = dzero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, a%get_ncols()
d(i) = d(i) + done
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csc_aclsum
subroutine psb_ld_csc_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_rowsum
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + (a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csc_rowsum
subroutine psb_ld_csc_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csc_mat_mod, psb_protect_name => psb_ld_csc_arwsum
class(psb_ld_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + abs(a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csc_arwsum
! == ===================================
!
!

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

@ -3333,6 +3333,261 @@ subroutine psb_ld_csr_scals(d,a,info)
end subroutine psb_ld_csr_scals
function psb_ld_csr_maxval(a) result(res)
use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_maxval
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: nnz
integer(psb_ipk_) :: info
character(len=20) :: name='ld_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_ld_csr_maxval
function psb_ld_csr_csnmi(a) result(res)
use psb_error_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_csnmi
implicit none
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nr, ir, jc, nc
real(psb_dpk_) :: acc
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='ld_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
end function psb_ld_csr_csnmi
subroutine psb_ld_csr_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_rowsum
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = dzero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + done
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csr_rowsum
subroutine psb_ld_csr_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_arwsum
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = dzero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + done
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csr_arwsum
subroutine psb_ld_csr_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_colsum
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = dzero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + done
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csr_colsum
subroutine psb_ld_csr_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_d_csr_mat_mod, psb_protect_name => psb_ld_csr_aclsum
class(psb_ld_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = dzero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + done
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ld_csr_aclsum
! == ===================================

227
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -4480,6 +4480,233 @@ subroutine psb_ld_scals(d,a,info)
end subroutine psb_ld_scals
function psb_ld_maxval(a) result(res)
use psb_d_mat_mod, psb_protect_name => psb_ld_maxval
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%maxval()
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_maxval
function psb_ld_csnmi(a) result(res)
use psb_d_mat_mod, psb_protect_name => psb_ld_csnmi
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnmi()
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_csnmi
function psb_ld_csnm1(a) result(res)
use psb_d_mat_mod, psb_protect_name => psb_ld_csnm1
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnm1()
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_csnm1
function psb_ld_rowsum(a,info) result(d)
use psb_d_mat_mod, psb_protect_name => psb_ld_rowsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_rowsum
function psb_ld_arwsum(a,info) result(d)
use psb_d_mat_mod, psb_protect_name => psb_ld_arwsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_arwsum
function psb_ld_colsum(a,info) result(d)
use psb_d_mat_mod, psb_protect_name => psb_ld_colsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_colsum
function psb_ld_aclsum(a,info) result(d)
use psb_d_mat_mod, psb_protect_name => psb_ld_aclsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_ldspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ld_aclsum
subroutine psb_ld_mv_from_ib(a,b)
use psb_error_mod
use psb_const_mod

191
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -1578,8 +1578,6 @@ subroutine psb_s_base_scal(d,a,info,side)
end subroutine psb_s_base_scal
function psb_s_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1770,7 +1768,6 @@ subroutine psb_s_base_aclsum(d,a)
end subroutine psb_s_base_aclsum
subroutine psb_s_base_get_diag(a,d,info)
use psb_error_mod
use psb_const_mod
@ -3434,8 +3431,6 @@ subroutine psb_ls_base_scals(d,a,info)
end subroutine psb_ls_base_scals
subroutine psb_ls_base_scal(d,a,info,side)
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_scal
use psb_error_mod
@ -3460,6 +3455,192 @@ subroutine psb_ls_base_scal(d,a,info,side)
end subroutine psb_ls_base_scal
function psb_ls_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_maxval
implicit none
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = szero
! 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 function psb_ls_base_maxval
function psb_ls_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_csnmi
implicit none
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_base_csnmi
function psb_ls_base_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_csnm1
implicit none
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_base_csnm1
subroutine psb_ls_base_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_rowsum
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ls_base_rowsum
subroutine psb_ls_base_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_arwsum
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ls_base_arwsum
subroutine psb_ls_base_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_colsum
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ls_base_colsum
subroutine psb_ls_base_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_base_aclsum
class(psb_ls_base_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_ls_base_aclsum
subroutine psb_ls_base_get_diag(a,d,info)
use psb_error_mod

321
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -29,7 +29,6 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_s_coo_get_diag(a,d,info)
use psb_s_base_mat_mod, psb_protect_name => psb_s_coo_get_diag
use psb_error_mod
@ -1936,7 +1935,6 @@ subroutine psb_s_coo_aclsum(d,a)
end subroutine psb_s_coo_aclsum
! == ==================================
!
!
@ -4159,7 +4157,6 @@ subroutine psb_ls_coo_get_diag(a,d,info)
end subroutine psb_ls_coo_get_diag
subroutine psb_ls_coo_scal(d,a,info,side)
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_scal
use psb_error_mod
@ -4267,6 +4264,324 @@ subroutine psb_ls_coo_scals(d,a,info)
end subroutine psb_ls_coo_scals
function psb_ls_coo_maxval(a) result(res)
use psb_error_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_maxval
implicit none
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
character(len=20) :: name='s_coo_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
res = sone
else
res = szero
end if
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_ls_coo_maxval
function psb_ls_coo_csnmi(a) result(res)
use psb_error_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_csnmi
implicit none
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_coo_csnmi'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = szero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_by_rows()) then
i = 1
j = i
res = szero
do while (i<=nnz)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1
enddo
if (is_unit) then
acc = sone
else
acc = szero
end if
do k=i, j-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
i = j
end do
else
m = a%get_nrows()
allocate(vt(m),stat=info)
if (info /= 0) return
if (is_unit) then
vt = sone
else
vt = szero
end if
do j=1, nnz
i = a%ia(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:m))
deallocate(vt,stat=info)
end if
end function psb_ls_coo_csnmi
function psb_ls_coo_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_csnm1
implicit none
class(psb_s_coo_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='ls_coo_csnm1'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = szero
nnz = a%get_nzeros()
n = a%get_ncols()
allocate(vt(n),stat=info)
if (info /= 0) return
if (a%is_unit()) then
vt = sone
else
vt = szero
end if
do j=1, nnz
i = a%ja(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:n))
deallocate(vt,stat=info)
return
end function psb_ls_coo_csnm1
subroutine psb_ls_coo_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_rowsum
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_coo_rowsum
subroutine psb_ls_coo_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_arwsum
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_coo_arwsum
subroutine psb_ls_coo_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_colsum
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_coo_colsum
subroutine psb_ls_coo_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_aclsum
class(psb_ls_coo_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_coo_aclsum
subroutine psb_ls_coo_reallocate_nz(nz,a)
use psb_s_base_mat_mod, psb_protect_name => psb_ls_coo_reallocate_nz
use psb_error_mod

273
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -3116,6 +3116,279 @@ subroutine psb_ls_csc_scals(d,a,info)
end subroutine psb_ls_csc_scals
function psb_ls_csc_maxval(a) result(res)
use psb_error_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_maxval
implicit none
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: nnz
character(len=20) :: name='ls_csc_maxval'
logical, parameter :: debug=.false.
if (a%is_unit()) then
res = sone
else
res = szero
end if
if (a%is_dev()) call a%sync()
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_ls_csc_maxval
function psb_ls_csc_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_csnm1
implicit none
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='ls_csc_csnm1'
logical, parameter :: debug=.false.
res = szero
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n
if (is_unit) then
acc = sone
else
acc = szero
end if
do k=a%icp(j),a%icp(j+1)-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
end do
return
end function psb_ls_csc_csnm1
subroutine psb_ls_csc_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_colsum
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = sone
else
d(i) = szero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csc_colsum
subroutine psb_ls_csc_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_aclsum
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_lpk_) :: m,n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = sone
else
d(i) = szero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, a%get_ncols()
d(i) = d(i) + sone
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csc_aclsum
subroutine psb_ls_csc_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_rowsum
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + (a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csc_rowsum
subroutine psb_ls_csc_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csc_mat_mod, psb_protect_name => psb_ls_csc_arwsum
class(psb_ls_csc_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = sone
else
d = szero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + abs(a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csc_arwsum
! == ===================================
!
!

257
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -1302,7 +1302,7 @@ function psb_s_csr_csnmi(a) result(res)
if (a%is_dev()) call a%sync()
do i = 1, a%get_nrows()
acc = dzero
acc = szero
do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j))
end do
@ -3333,6 +3333,261 @@ subroutine psb_ls_csr_scals(d,a,info)
end subroutine psb_ls_csr_scals
function psb_ls_csr_maxval(a) result(res)
use psb_error_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_maxval
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: nnz
integer(psb_ipk_) :: info
character(len=20) :: name='ls_csr_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = szero
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_ls_csr_maxval
function psb_ls_csr_csnmi(a) result(res)
use psb_error_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_csnmi
implicit none
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nr, ir, jc, nc
real(psb_spk_) :: acc
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='ls_csnmi'
logical, parameter :: debug=.false.
res = szero
if (a%is_dev()) call a%sync()
do i = 1, a%get_nrows()
acc = szero
do j=a%irp(i),a%irp(i+1)-1
acc = acc + abs(a%val(j))
end do
res = max(res,acc)
end do
end function psb_ls_csr_csnmi
subroutine psb_ls_csr_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_rowsum
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = szero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + sone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csr_rowsum
subroutine psb_ls_csr_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_arwsum
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = szero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + sone
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csr_arwsum
subroutine psb_ls_csr_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_colsum
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = szero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + sone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csr_colsum
subroutine psb_ls_csr_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_s_csr_mat_mod, psb_protect_name => psb_ls_csr_aclsum
class(psb_ls_csr_sparse_mat), intent(in) :: a
real(psb_spk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_spk_) :: acc
real(psb_spk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = szero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + sone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_ls_csr_aclsum
! == ===================================

227
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -4480,6 +4480,233 @@ subroutine psb_ls_scals(d,a,info)
end subroutine psb_ls_scals
function psb_ls_maxval(a) result(res)
use psb_s_mat_mod, psb_protect_name => psb_ls_maxval
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%maxval()
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_maxval
function psb_ls_csnmi(a) result(res)
use psb_s_mat_mod, psb_protect_name => psb_ls_csnmi
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnmi()
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_csnmi
function psb_ls_csnm1(a) result(res)
use psb_s_mat_mod, psb_protect_name => psb_ls_csnm1
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnm1()
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_csnm1
function psb_ls_rowsum(a,info) result(d)
use psb_s_mat_mod, psb_protect_name => psb_ls_rowsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_rowsum
function psb_ls_arwsum(a,info) result(d)
use psb_s_mat_mod, psb_protect_name => psb_ls_arwsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_arwsum
function psb_ls_colsum(a,info) result(d)
use psb_s_mat_mod, psb_protect_name => psb_ls_colsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_colsum
function psb_ls_aclsum(a,info) result(d)
use psb_s_mat_mod, psb_protect_name => psb_ls_aclsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lsspmat_type), intent(in) :: a
real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_ls_aclsum
subroutine psb_ls_mv_from_ib(a,b)
use psb_error_mod
use psb_const_mod

191
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -1578,8 +1578,6 @@ subroutine psb_z_base_scal(d,a,info,side)
end subroutine psb_z_base_scal
function psb_z_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1770,7 +1768,6 @@ subroutine psb_z_base_aclsum(d,a)
end subroutine psb_z_base_aclsum
subroutine psb_z_base_get_diag(a,d,info)
use psb_error_mod
use psb_const_mod
@ -3434,8 +3431,6 @@ subroutine psb_lz_base_scals(d,a,info)
end subroutine psb_lz_base_scals
subroutine psb_lz_base_scal(d,a,info,side)
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_scal
use psb_error_mod
@ -3460,6 +3455,192 @@ subroutine psb_lz_base_scal(d,a,info,side)
end subroutine psb_lz_base_scal
function psb_lz_base_maxval(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_maxval
implicit none
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = dzero
! 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 function psb_lz_base_maxval
function psb_lz_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_csnmi
implicit none
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_base_csnmi
function psb_lz_base_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_realloc_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_csnm1
implicit none
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_base_csnm1
subroutine psb_lz_base_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_rowsum
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lz_base_rowsum
subroutine psb_lz_base_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_arwsum
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lz_base_arwsum
subroutine psb_lz_base_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_colsum
class(psb_lz_base_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lz_base_colsum
subroutine psb_lz_base_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_base_aclsum
class(psb_lz_base_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
call psb_error_handler(err_act)
end subroutine psb_lz_base_aclsum
subroutine psb_lz_base_get_diag(a,d,info)
use psb_error_mod

321
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -29,7 +29,6 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
subroutine psb_z_coo_get_diag(a,d,info)
use psb_z_base_mat_mod, psb_protect_name => psb_z_coo_get_diag
use psb_error_mod
@ -1936,7 +1935,6 @@ subroutine psb_z_coo_aclsum(d,a)
end subroutine psb_z_coo_aclsum
! == ==================================
!
!
@ -4159,7 +4157,6 @@ subroutine psb_lz_coo_get_diag(a,d,info)
end subroutine psb_lz_coo_get_diag
subroutine psb_lz_coo_scal(d,a,info,side)
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_scal
use psb_error_mod
@ -4267,6 +4264,324 @@ subroutine psb_lz_coo_scals(d,a,info)
end subroutine psb_lz_coo_scals
function psb_lz_coo_maxval(a) result(res)
use psb_error_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_maxval
implicit none
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
character(len=20) :: name='z_coo_maxval'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
if (a%is_unit()) then
res = done
else
res = dzero
end if
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_lz_coo_maxval
function psb_lz_coo_csnmi(a) result(res)
use psb_error_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_csnmi
implicit none
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_coo_csnmi'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = dzero
nnz = a%get_nzeros()
is_unit = a%is_unit()
if (a%is_by_rows()) then
i = 1
j = i
res = dzero
do while (i<=nnz)
do while ((a%ia(j) == a%ia(i)).and. (j <= nnz))
j = j+1
enddo
if (is_unit) then
acc = done
else
acc = dzero
end if
do k=i, j-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
i = j
end do
else
m = a%get_nrows()
allocate(vt(m),stat=info)
if (info /= 0) return
if (is_unit) then
vt = done
else
vt = dzero
end if
do j=1, nnz
i = a%ia(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:m))
deallocate(vt,stat=info)
end if
end function psb_lz_coo_csnmi
function psb_lz_coo_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_csnm1
implicit none
class(psb_z_coo_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='lz_coo_csnm1'
logical, parameter :: debug=.false.
if (a%is_dev()) call a%sync()
res = dzero
nnz = a%get_nzeros()
n = a%get_ncols()
allocate(vt(n),stat=info)
if (info /= 0) return
if (a%is_unit()) then
vt = done
else
vt = dzero
end if
do j=1, nnz
i = a%ja(j)
vt(i) = vt(i) + abs(a%val(j))
end do
res = maxval(vt(1:n))
deallocate(vt,stat=info)
return
end function psb_lz_coo_csnm1
subroutine psb_lz_coo_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_rowsum
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = zone
else
d = zzero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_coo_rowsum
subroutine psb_lz_coo_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_arwsum
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,n, nnz, ir, jc, nc
integer(psb_epk_) :: m
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),m/))
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
nnz = a%get_nzeros()
do j=1, nnz
i = a%ia(j)
d(i) = d(i) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_coo_arwsum
subroutine psb_lz_coo_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_colsum
class(psb_lz_coo_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = zone
else
d = zzero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + a%val(j)
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_coo_colsum
subroutine psb_lz_coo_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_aclsum
class(psb_lz_coo_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m, nnz, ir, jc, nc
integer(psb_epk_) :: n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
call psb_errpush(info,name,e_err=(/1_psb_epk_,size(d,kind=psb_epk_),n/))
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
nnz = a%get_nzeros()
do j=1, nnz
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_coo_aclsum
subroutine psb_lz_coo_reallocate_nz(nz,a)
use psb_z_base_mat_mod, psb_protect_name => psb_lz_coo_reallocate_nz
use psb_error_mod

273
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -3116,6 +3116,279 @@ subroutine psb_lz_csc_scals(d,a,info)
end subroutine psb_lz_csc_scals
function psb_lz_csc_maxval(a) result(res)
use psb_error_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_maxval
implicit none
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: nnz
character(len=20) :: name='lz_csc_maxval'
logical, parameter :: debug=.false.
if (a%is_unit()) then
res = done
else
res = dzero
end if
if (a%is_dev()) call a%sync()
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_lz_csc_maxval
function psb_lz_csc_csnm1(a) result(res)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_csnm1
implicit none
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc, info
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act
character(len=20) :: name='lz_csc_csnm1'
logical, parameter :: debug=.false.
res = dzero
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
is_unit = a%is_unit()
do j=1, n
if (is_unit) then
acc = done
else
acc = dzero
end if
do k=a%icp(j),a%icp(j+1)-1
acc = acc + abs(a%val(k))
end do
res = max(res,acc)
end do
return
end function psb_lz_csc_csnm1
subroutine psb_lz_csc_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_colsum
class(psb_lz_csc_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = zone
else
d(i) = zzero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csc_colsum
subroutine psb_lz_csc_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_aclsum
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_lpk_) :: m,n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra, is_unit
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
is_unit = a%is_unit()
do i = 1, a%get_ncols()
if (is_unit) then
d(i) = done
else
d(i) = dzero
end if
do j=a%icp(i),a%icp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, a%get_ncols()
d(i) = d(i) + done
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csc_aclsum
subroutine psb_lz_csc_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_rowsum
class(psb_lz_csc_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = zone
else
d = zzero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + (a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csc_rowsum
subroutine psb_lz_csc_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csc_mat_mod, psb_protect_name => psb_lz_csc_arwsum
class(psb_lz_csc_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,nnz, ir, jc, nc
integer(psb_epk_) :: m,n
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_ncols()
n = a%get_nrows()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
if (a%is_unit()) then
d = done
else
d = dzero
end if
do i=1, m
do j=a%icp(i),a%icp(i+1)-1
k = a%ia(j)
d(k) = d(k) + abs(a%val(k))
end do
end do
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csc_arwsum
! == ===================================
!
!

255
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -3333,6 +3333,261 @@ subroutine psb_lz_csr_scals(d,a,info)
end subroutine psb_lz_csr_scals
function psb_lz_csr_maxval(a) result(res)
use psb_error_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_maxval
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: nnz
integer(psb_ipk_) :: info
character(len=20) :: name='lz_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_lz_csr_maxval
function psb_lz_csr_csnmi(a) result(res)
use psb_error_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_csnmi
implicit none
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_lpk_) :: i,j,k,m,n, nr, ir, jc, nc
real(psb_dpk_) :: acc
logical :: tra
integer(psb_ipk_) :: err_act
character(len=20) :: name='lz_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
end function psb_lz_csr_csnmi
subroutine psb_lz_csr_rowsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_rowsum
class(psb_lz_csr_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = zzero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + zone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csr_rowsum
subroutine psb_lz_csr_arwsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_arwsum
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
if (size(d) < m) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = m
call psb_errpush(info,name,e_err=err)
goto 9999
end if
do i = 1, a%get_nrows()
d(i) = dzero
do j=a%irp(i),a%irp(i+1)-1
d(i) = d(i) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, m
d(i) = d(i) + done
end do
end if
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csr_arwsum
subroutine psb_lz_csr_colsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_colsum
class(psb_lz_csr_sparse_mat), intent(in) :: a
complex(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
complex(psb_dpk_) :: acc
complex(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = zzero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + (a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + zone
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csr_colsum
subroutine psb_lz_csr_aclsum(d,a)
use psb_error_mod
use psb_const_mod
use psb_z_csr_mat_mod, psb_protect_name => psb_lz_csr_aclsum
class(psb_lz_csr_sparse_mat), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:)
integer(psb_lpk_) :: i,j,k,m,n, nnz, ir, jc, nc
real(psb_dpk_) :: acc
real(psb_dpk_), allocatable :: vt(:)
logical :: tra
integer(psb_ipk_) :: err_act, info
integer(psb_epk_) :: err(5)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
if (a%is_dev()) call a%sync()
m = a%get_nrows()
n = a%get_ncols()
if (size(d) < n) then
info=psb_err_input_asize_small_i_
err(1) = 1; err(2) = size(d); err(3) = n
call psb_errpush(info,name,e_err=err)
goto 9999
end if
d = dzero
do i=1, m
do j=a%irp(i),a%irp(i+1)-1
k = a%ja(j)
d(k) = d(k) + abs(a%val(j))
end do
end do
if (a%is_unit()) then
do i=1, n
d(i) = d(i) + done
end do
end if
return
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end subroutine psb_lz_csr_aclsum
! == ===================================

227
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -4480,6 +4480,233 @@ subroutine psb_lz_scals(d,a,info)
end subroutine psb_lz_scals
function psb_lz_maxval(a) result(res)
use psb_z_mat_mod, psb_protect_name => psb_lz_maxval
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%maxval()
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_maxval
function psb_lz_csnmi(a) result(res)
use psb_z_mat_mod, psb_protect_name => psb_lz_csnmi
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnmi'
logical, parameter :: debug=.false.
info = psb_success_
call psb_get_erraction(err_act)
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnmi()
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_csnmi
function psb_lz_csnm1(a) result(res)
use psb_z_mat_mod, psb_protect_name => psb_lz_csnm1
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_) :: res
integer(psb_ipk_) :: err_act, info
character(len=20) :: name='csnm1'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
res = a%a%spnm1()
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_csnm1
function psb_lz_rowsum(a,info) result(d)
use psb_z_mat_mod, psb_protect_name => psb_lz_rowsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
complex(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_rowsum
function psb_lz_arwsum(a,info) result(d)
use psb_z_mat_mod, psb_protect_name => psb_lz_arwsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_arwsum
function psb_lz_colsum(a,info) result(d)
use psb_z_mat_mod, psb_protect_name => psb_lz_colsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
complex(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_colsum
function psb_lz_aclsum(a,info) result(d)
use psb_z_mat_mod, psb_protect_name => psb_lz_aclsum
use psb_error_mod
use psb_const_mod
implicit none
class(psb_lzspmat_type), intent(in) :: a
real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_erractionsave(err_act)
info = psb_success_
if (.not.allocated(a%a)) then
info = psb_err_invalid_mat_state_
call psb_errpush(info,name)
goto 9999
endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
return
end function psb_lz_aclsum
subroutine psb_lz_mv_from_ib(a,b)
use psb_error_mod
use psb_const_mod

Write Preview
Loading…
Cancel
Save