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

Defining and using new routines: psb_sp_trim psb_sp_clip.

Browse Source
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent b97283eed5
commit aafb62405a
13 changed files with 666 additions and 313 deletions
Show Stats Download Patch File Download Diff File

5
Changelog
Unescape Escape View File

@ -1,6 +1,11 @@
Changelog. A lot less detailed than usual, at least for past Changelog. A lot less detailed than usual, at least for past
history. history.
2007/02/22: Fixed various misalignments between real and complex.
Defined new psb_sp_clip routines.
Fixed psb_rwextd.
Changed the USE statements, minimizing size of modules and
maximizing consistency checks.
2007/02/01: Merged serial version: we provide a minimal fake mpi to 2007/02/01: Merged serial version: we provide a minimal fake mpi to
allow compiling and running without mpi and blacs. Only allow compiling and running without mpi and blacs. Only

532
base/modules/psb_serial_mod.f90
Unescape Escape View File

@ -33,315 +33,335 @@ module psb_serial_mod
use psb_string_mod use psb_string_mod
interface psb_csdp interface psb_csdp
subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(inout) :: b type(psb_dspmat_type), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ifc,upd,dupl integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd character, intent(in), optional :: check,trans,unitd
end subroutine psb_dcsdp end subroutine psb_dcsdp
subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(inout) :: b type(psb_zspmat_type), intent(inout) :: b
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ifc,upd,dupl integer, intent(in), optional :: ifc,upd,dupl
character, intent(in), optional :: check,trans,unitd character, intent(in), optional :: check,trans,unitd
end subroutine psb_zcsdp end subroutine psb_zcsdp
end interface end interface
interface psb_csrws interface psb_csrws
subroutine psb_dcsrws(rw,a,info,trans) subroutine psb_dcsrws(rw,a,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
real(kind(1.d0)), allocatable :: rw(:) real(kind(1.d0)), allocatable :: rw(:)
integer :: info integer :: info
character, optional :: trans character, optional :: trans
end subroutine psb_dcsrws end subroutine psb_dcsrws
subroutine psb_zcsrws(rw,a,info,trans) subroutine psb_zcsrws(rw,a,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
complex(kind(1.d0)), allocatable :: rw(:) complex(kind(1.d0)), allocatable :: rw(:)
integer :: info integer :: info
character, optional :: trans character, optional :: trans
end subroutine psb_zcsrws end subroutine psb_zcsrws
end interface end interface
interface psb_cssm interface psb_cssm
subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: t type(psb_dspmat_type) :: t
real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:)
integer :: info integer :: info
character, optional :: trans, unitd character, optional :: trans, unitd
real(kind(1.d0)), optional, target :: d(:) real(kind(1.d0)), optional, target :: d(:)
end subroutine psb_dcssm end subroutine psb_dcssm
subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: t type(psb_dspmat_type) :: t
real(kind(1.d0)) :: alpha, beta, b(:), c(:) real(kind(1.d0)) :: alpha, beta, b(:), c(:)
integer :: info integer :: info
character, optional :: trans, unitd character, optional :: trans, unitd
real(kind(1.d0)), optional, target :: d(:) real(kind(1.d0)), optional, target :: d(:)
end subroutine psb_dcssv end subroutine psb_dcssv
subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: t type(psb_zspmat_type) :: t
complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:)
integer :: info integer :: info
character, optional :: trans, unitd character, optional :: trans, unitd
complex(kind(1.d0)), optional, target :: d(:) complex(kind(1.d0)), optional, target :: d(:)
end subroutine psb_zcssm end subroutine psb_zcssm
subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: t type(psb_zspmat_type) :: t
complex(kind(1.d0)) :: alpha, beta, b(:), c(:) complex(kind(1.d0)) :: alpha, beta, b(:), c(:)
integer :: info integer :: info
character, optional :: trans, unitd character, optional :: trans, unitd
complex(kind(1.d0)), optional, target :: d(:) complex(kind(1.d0)), optional, target :: d(:)
end subroutine psb_zcssv end subroutine psb_zcssv
end interface end interface
interface psb_csmm interface psb_csmm
subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
real(kind(1.d0)) :: alpha, beta, b(:), c(:) real(kind(1.d0)) :: alpha, beta, b(:), c(:)
integer :: info integer :: info
character, optional :: trans character, optional :: trans
end subroutine psb_dcsmv end subroutine psb_dcsmv
subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: a type(psb_dspmat_type) :: a
real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:)
integer :: info integer :: info
character, optional :: trans character, optional :: trans
end subroutine psb_dcsmm end subroutine psb_dcsmm
subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans) subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
complex(kind(1.d0)) :: alpha, beta, b(:), c(:) complex(kind(1.d0)) :: alpha, beta, b(:), c(:)
integer :: info integer :: info
character, optional :: trans character, optional :: trans
end subroutine psb_zcsmv end subroutine psb_zcsmv
subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans) subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a type(psb_zspmat_type) :: a
complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:)
integer :: info integer :: info
character, optional :: trans character, optional :: trans
end subroutine psb_zcsmm end subroutine psb_zcsmm
end interface end interface
interface psb_fixcoo interface psb_fixcoo
subroutine psb_dfixcoo(a,info,idir) subroutine psb_dfixcoo(a,info,idir)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: idir integer, intent(in), optional :: idir
end subroutine psb_dfixcoo end subroutine psb_dfixcoo
subroutine psb_zfixcoo(a,info,idir) subroutine psb_zfixcoo(a,info,idir)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: idir integer, intent(in), optional :: idir
end subroutine psb_zfixcoo end subroutine psb_zfixcoo
end interface end interface
interface psb_ipcoo2csr interface psb_ipcoo2csr
subroutine psb_dipcoo2csr(a,info,rwshr) subroutine psb_dipcoo2csr(a,info,rwshr)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: rwshr logical, optional :: rwshr
end subroutine psb_dipcoo2csr end subroutine psb_dipcoo2csr
subroutine psb_zipcoo2csr(a,info,rwshr) subroutine psb_zipcoo2csr(a,info,rwshr)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: rwshr logical, optional :: rwshr
end subroutine psb_zipcoo2csr end subroutine psb_zipcoo2csr
end interface end interface
interface psb_ipcoo2csc interface psb_ipcoo2csc
subroutine psb_dipcoo2csc(a,info,clshr) subroutine psb_dipcoo2csc(a,info,clshr)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: clshr logical, optional :: clshr
end subroutine psb_dipcoo2csc end subroutine psb_dipcoo2csc
subroutine psb_zipcoo2csc(a,info,clshr) subroutine psb_zipcoo2csc(a,info,clshr)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
logical, optional :: clshr logical, optional :: clshr
end subroutine psb_zipcoo2csc end subroutine psb_zipcoo2csc
end interface end interface
interface psb_ipcsr2coo interface psb_ipcsr2coo
subroutine psb_dipcsr2coo(a,info) subroutine psb_dipcsr2coo(a,info)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_dipcsr2coo end subroutine psb_dipcsr2coo
subroutine psb_zipcsr2coo(a,info) subroutine psb_zipcsr2coo(a,info)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
end subroutine psb_zipcsr2coo end subroutine psb_zipcsr2coo
end interface end interface
interface psb_csprt interface psb_csprt
subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: iout integer, intent(in) :: iout
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:) integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: irs,ics integer, intent(in), optional :: irs,ics
character(len=*), optional :: head character(len=*), optional :: head
integer, intent(in), optional :: ivr(:),ivc(:) integer, intent(in), optional :: ivr(:),ivc(:)
end subroutine psb_dcsprt end subroutine psb_dcsprt
subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: iout integer, intent(in) :: iout
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(in), optional :: iv(:) integer, intent(in), optional :: iv(:)
integer, intent(in), optional :: irs,ics integer, intent(in), optional :: irs,ics
character(len=*), optional :: head character(len=*), optional :: head
integer, intent(in), optional :: ivr(:),ivc(:) integer, intent(in), optional :: ivr(:),ivc(:)
end subroutine psb_zcsprt end subroutine psb_zcsprt
end interface end interface
interface psb_neigh interface psb_neigh
subroutine psb_dneigh(a,idx,neigh,n,info,lev) subroutine psb_dneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: idx integer, intent(in) :: idx
integer, intent(out) :: n integer, intent(out) :: n
integer, allocatable :: neigh(:) integer, allocatable :: neigh(:)
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: lev integer, optional, intent(in) :: lev
end subroutine psb_dneigh end subroutine psb_dneigh
subroutine psb_zneigh(a,idx,neigh,n,info,lev) subroutine psb_zneigh(a,idx,neigh,n,info,lev)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: idx integer, intent(in) :: idx
integer, intent(out) :: n integer, intent(out) :: n
integer, allocatable :: neigh(:) integer, allocatable :: neigh(:)
integer, intent(out) :: info integer, intent(out) :: info
integer, optional, intent(in) :: lev integer, optional, intent(in) :: lev
end subroutine psb_zneigh end subroutine psb_zneigh
end interface end interface
interface psb_coins interface psb_coins
subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:) integer, intent(in) :: ia(:),ja(:)
real(kind(1.d0)), intent(in) :: val(:) real(kind(1.d0)), intent(in) :: val(:)
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: gtl(:) integer, intent(in), optional :: gtl(:)
logical, optional, intent(in) :: rebuild logical, optional, intent(in) :: rebuild
end subroutine psb_dcoins end subroutine psb_dcoins
subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: nz, imin,imax,jmin,jmax integer, intent(in) :: nz, imin,imax,jmin,jmax
integer, intent(in) :: ia(:),ja(:) integer, intent(in) :: ia(:),ja(:)
complex(kind(1.d0)), intent(in) :: val(:) complex(kind(1.d0)), intent(in) :: val(:)
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: gtl(:) integer, intent(in), optional :: gtl(:)
logical, optional, intent(in) :: rebuild logical, optional, intent(in) :: rebuild
end subroutine psb_zcoins end subroutine psb_zcoins
end interface end interface
interface psb_symbmm interface psb_symbmm
subroutine psb_dsymbmm(a,b,c,info) subroutine psb_dsymbmm(a,b,c,info)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: a,b,c type(psb_dspmat_type) :: a,b,c
integer :: info integer :: info
end subroutine psb_dsymbmm end subroutine psb_dsymbmm
subroutine psb_zsymbmm(a,b,c,info) subroutine psb_zsymbmm(a,b,c,info)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a,b,c type(psb_zspmat_type) :: a,b,c
integer :: info integer :: info
end subroutine psb_zsymbmm end subroutine psb_zsymbmm
end interface end interface
interface psb_numbmm interface psb_numbmm
subroutine psb_dnumbmm(a,b,c) subroutine psb_dnumbmm(a,b,c)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: a,b,c type(psb_dspmat_type) :: a,b,c
end subroutine psb_dnumbmm end subroutine psb_dnumbmm
subroutine psb_znumbmm(a,b,c) subroutine psb_znumbmm(a,b,c)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a,b,c type(psb_zspmat_type) :: a,b,c
end subroutine psb_znumbmm end subroutine psb_znumbmm
end interface end interface
interface psb_transp interface psb_transp
subroutine psb_dtransp(a,b,c,fmt) subroutine psb_dtransp(a,b,c,fmt)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type) :: a,b type(psb_dspmat_type) :: a,b
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_dtransp end subroutine psb_dtransp
subroutine psb_ztransp(a,b,c,fmt) subroutine psb_ztransp(a,b,c,fmt)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a,b type(psb_zspmat_type) :: a,b
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_ztransp end subroutine psb_ztransp
end interface end interface
interface psb_transc interface psb_transc
subroutine psb_ztransc(a,b,c,fmt) subroutine psb_ztransc(a,b,c,fmt)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type) :: a,b type(psb_zspmat_type) :: a,b
integer, optional :: c integer, optional :: c
character(len=*), optional :: fmt character(len=*), optional :: fmt
end subroutine psb_ztransc end subroutine psb_ztransc
end interface end interface
interface psb_rwextd interface psb_rwextd
subroutine psb_drwextd(nr,a,info,b,rowscale) subroutine psb_drwextd(nr,a,info,b,rowscale)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: nr integer, intent(in) :: nr
type(psb_dspmat_type), intent(inout) :: a type(psb_dspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
type(psb_dspmat_type), intent(in), optional :: b type(psb_dspmat_type), intent(in), optional :: b
logical, intent(in), optional :: rowscale logical, intent(in), optional :: rowscale
end subroutine psb_drwextd end subroutine psb_drwextd
subroutine psb_zrwextd(nr,a,info,b,rowscale) subroutine psb_zrwextd(nr,a,info,b,rowscale)
use psb_spmat_type use psb_spmat_type
integer, intent(in) :: nr integer, intent(in) :: nr
type(psb_zspmat_type), intent(inout) :: a type(psb_zspmat_type), intent(inout) :: a
integer, intent(out) :: info integer, intent(out) :: info
type(psb_zspmat_type), intent(in), optional :: b type(psb_zspmat_type), intent(in), optional :: b
logical, intent(in), optional :: rowscale logical, intent(in), optional :: rowscale
end subroutine psb_zrwextd end subroutine psb_zrwextd
end interface end interface
interface psb_csnmi interface psb_csnmi
real(kind(1.d0)) function psb_dcsnmi(a,info,trans) real(kind(1.d0)) function psb_dcsnmi(a,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
integer, intent(out) :: info integer, intent(out) :: info
character, optional :: trans character, optional :: trans
end function psb_dcsnmi end function psb_dcsnmi
real(kind(1.d0)) function psb_zcsnmi(a,info,trans) real(kind(1.d0)) function psb_zcsnmi(a,info,trans)
use psb_spmat_type use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(out) :: info integer, intent(out) :: info
character, optional :: trans character, optional :: trans
end function psb_zcsnmi end function psb_zcsnmi
end interface end interface
interface psb_sp_clip
subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(out) :: b
integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_dspclip
subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
end subroutine psb_zspclip
end interface
interface psb_sp_getdiag interface psb_sp_getdiag
subroutine psb_dspgtdiag(a,d,info) subroutine psb_dspgtdiag(a,d,info)

53
base/modules/psb_spmat_type.f90
Unescape Escape View File

@ -127,6 +127,10 @@ module psb_spmat_type
module procedure psb_dsp_transfer, psb_zsp_transfer module procedure psb_dsp_transfer, psb_zsp_transfer
end interface end interface
interface psb_sp_trim
module procedure psb_dsp_trim, psb_zsp_trim
end interface
interface psb_sp_trimsize interface psb_sp_trimsize
module procedure psb_dsp_trimsize, psb_zsp_trimsize module procedure psb_dsp_trimsize, psb_zsp_trimsize
end interface end interface
@ -643,6 +647,55 @@ contains
end subroutine psb_dsp_setifld end subroutine psb_dsp_setifld
!
! Reduce the size of A to the barest minimum necessary.
!
!
subroutine psb_dsp_trim(a,info)
use psb_string_mod
implicit none
!....Parameters...
Type(psb_dspmat_type), intent(inout) :: A
Integer, intent(out) :: info
Integer :: i1, i2, ia
!locals
Integer :: nza
logical, parameter :: debug=.false.
info = 0
call psb_sp_trimsize(a,i1,i2,ia,info)
i1 = max(i1,1); i2 = max(i2,1); ia = max(ia,1)
if (info == 0) call psb_sp_reall(a,i1,i2,ia,info)
Return
End Subroutine psb_dsp_trim
subroutine psb_zsp_trim(a,info)
use psb_string_mod
implicit none
!....Parameters...
Type(psb_zspmat_type), intent(inout) :: A
Integer, intent(out) :: info
Integer :: i1, i2, ia
!locals
Integer :: nza
logical, parameter :: debug=.false.
info = 0
call psb_sp_trimsize(a,i1,i2,ia,info)
i1 = max(i1,1); i2 = max(i2,1); ia = max(ia,1)
if (info == 0) call psb_sp_reall(a,i1,i2,ia,info)
Return
End Subroutine psb_zsp_trim
subroutine psb_dsp_trimsize(a, i1,i2,ia,info) subroutine psb_dsp_trimsize(a, i1,i2,ia,info)
use psb_string_mod use psb_string_mod
implicit none implicit none

4
base/serial/Makefile
Unescape Escape View File

@ -5,13 +5,13 @@ FOBJS = psb_cest.o psb_dcoins.o psb_dcsdp.o psb_dcsmm.o psb_dcsmv.o \
psb_dcsnmi.o psb_dcsprt.o psb_dcsrws.o psb_dcssm.o psb_dcssv.o \ psb_dcsnmi.o psb_dcsprt.o psb_dcsrws.o psb_dcssm.o psb_dcssv.o \
psb_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.o \ psb_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.o \
psb_dnumbmm.o psb_drwextd.o psb_dspgtdiag.o psb_dspgtblk.o \ psb_dnumbmm.o psb_drwextd.o psb_dspgtdiag.o psb_dspgtblk.o \
psb_dspscal.o psb_dsymbmm.o psb_dtransp.o \ psb_dspscal.o psb_dsymbmm.o psb_dtransp.o psb_dspclip.o\
psb_dipcoo2csc.o psb_dspgetrow.o lsame.o psb_zspgetrow.o\ psb_dipcoo2csc.o psb_dspgetrow.o lsame.o psb_zspgetrow.o\
psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\ psb_zcsmm.o psb_zcsmv.o psb_zspgtdiag.o psb_zspgtblk.o\
psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zcsdp.o\ psb_zcsnmi.o psb_zcsrws.o psb_zcssm.o psb_zcssv.o psb_zcsdp.o\
psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \ psb_zfixcoo.o psb_zipcoo2csr.o psb_zipcsr2coo.o psb_zipcoo2csc.o \
psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\ psb_zcoins.o psb_zcsprt.o psb_zneigh.o psb_ztransp.o psb_ztransc.o\
psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o\ psb_zrwextd.o psb_zsymbmm.o psb_znumbmm.o psb_zspscal.o psb_zspclip.o\
psb_getifield.o psb_setifield.o psb_update_mod.o psb_getifield.o psb_setifield.o psb_update_mod.o
LIBDIR = .. LIBDIR = ..

6
base/serial/psb_dcsdp.f90
Unescape Escape View File

@ -388,10 +388,8 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end select end select
if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) &
call psb_sp_trimsize(b,i1,i2,ia,info) & call psb_sp_trim(b,info)
if (info == 0) call psb_sp_reall(b,i1,i2,ia,info)
endif
else if (check_=='R') then else if (check_=='R') then

157
base/serial/psb_dspclip.f90
Unescape Escape View File

@ -0,0 +1,157 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_dspclip.f90
! Subroutine: psb_dspclip
! Creates a "clipped" copy of input matrix A. Output is always in COO.
! Parameters:
!*****************************************************************************
!* *
!*****************************************************************************
subroutine psb_dspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, psb_protect_name => psb_dspclip
implicit none
type(psb_dspmat_type), intent(in) :: a
type(psb_dspmat_type), intent(out) :: b
integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer :: lrw_, ierr(5), err_act
type(psb_dspmat_type) :: tmp
character(len=20) :: name, ch_err
integer :: imin_,imax_,jmin_,jmax_
logical :: rscale_,cscale_
integer :: sizeb, nzb, mb, kb, ifst, ilst, nrt, nzt, i, j
integer, parameter :: irbk=40, inzr=16
name='psb_dsp_clip'
info = 0
call psb_erractionsave(err_act)
call psb_set_erraction(0)
call psb_nullify_sp(b)
call psb_sp_all(tmp,inzr*irbk,info)
if (present(imin)) then
imin_ = imin
else
imin_ = 1
endif
if (present(imax)) then
imax_ = imax
else
imax_ = a%m
endif
if (present(jmin)) then
jmin_ = jmin
else
jmin_ = 1
endif
if (present(jmax)) then
jmax_ = jmax
else
jmax_ = a%k
endif
if (present(rscale)) then
rscale_ = rscale
else
rscale_ = .true.
endif
if (present(cscale)) then
cscale_ = cscale
else
cscale_ = .true.
endif
if (rscale_) then
mb = imax_ - imin_ +1
else
mb = a%m ! Should this be imax_ ??
endif
if (cscale_) then
kb = jmax_ - jmin_ +1
else
kb = a%k ! Should this be jmax_ ??
endif
sizeb = psb_sp_get_nnzeros(a)
call psb_sp_all(mb,kb,b,sizeb,info)
b%fida='COO'
nzb = 0
do i=imin_, imax_, irbk
nrt = min(irbk,imax_-i+1)
ifst = i
ilst = ifst + nrt - 1
call psb_sp_getblk(ifst,a,tmp,info,lrw=ilst)
nzt = psb_sp_get_nnzeros(tmp)
do j=1, nzt
if ((jmin_ <= tmp%ia2(j)).and.(tmp%ia2(j) <= jmax_)) then
nzb = nzb + 1
b%aspk(nzb) = tmp%aspk(j)
b%ia1(nzb) = tmp%ia1(j)
b%ia2(nzb) = tmp%ia2(j)
end if
end do
end do
b%infoa(psb_nnz_) = nzb
if (rscale_) then
do i=1, nzb
b%ia1(i) = b%ia1(i) - imin_ + 1
end do
end if
if (cscale_) then
do i=1, nzb
b%ia2(i) = b%ia2(i) - jmin_ + 1
end do
end if
call psb_fixcoo(b,info)
call psb_sp_trim(b,info)
call psb_sp_free(tmp,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_dspclip

23
base/serial/psb_dspgetrow.f90
Unescape Escape View File

@ -42,6 +42,8 @@
subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw) subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type use psb_spmat_type
use psb_string_mod use psb_string_mod
use psb_serial_mod, psb_protect_name => psb_dspgetrow
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw integer, intent(in) :: irw
integer, intent(out) :: nz integer, intent(out) :: nz
@ -50,23 +52,6 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
integer, intent(in), target, optional :: iren(:) integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw integer, intent(in), optional :: lrw
integer, intent(out) :: info integer, intent(out) :: info
interface psb_spgtblk
subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
! Output is always in COO format into B, irrespective of
! the input format
use psb_spmat_type
use psb_const_mod
implicit none
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_dspmat_type), intent(inout) :: b
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
end subroutine psb_dspgtblk
end interface
integer :: lrw_, ierr(5), err_act integer :: lrw_, ierr(5), err_act
type(psb_dspmat_type) :: b type(psb_dspmat_type) :: b
@ -93,9 +78,9 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
call psb_sp_all(lrw_-irw+1,lrw_-irw+1,b,info) call psb_sp_all(lrw_-irw+1,lrw_-irw+1,b,info)
if (present(iren)) then if (present(iren)) then
call psb_spgtblk(irw,a,b,info,iren=iren,lrw=lrw_) call psb_sp_getblk(irw,a,b,info,iren=iren,lrw=lrw_)
else else
call psb_spgtblk(irw,a,b,info,lrw=lrw_) call psb_sp_getblk(irw,a,b,info,lrw=lrw_)
end if end if
if (info /= 0) then if (info /= 0) then
info=136 info=136

1
base/serial/psb_dspgtblk.f90
Unescape Escape View File

@ -32,7 +32,6 @@
! Subroutine: psb_dspgtblk ! Subroutine: psb_dspgtblk
! Gets one or more rows from a sparse matrix. ! Gets one or more rows from a sparse matrix.
! Parameters: ! Parameters:
!***************************************************************************** !*****************************************************************************
!* * !* *
!* Takes a specified row from matrix A and copies into matrix B (possibly * !* Takes a specified row from matrix A and copies into matrix B (possibly *

7
base/serial/psb_zcsdp.f90
Unescape Escape View File

@ -389,10 +389,9 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
end select end select
if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then
call psb_sp_trimsize(b,i1,i2,ia,info) if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) &
if (info == 0) call psb_sp_reall(b,i1,i2,ia,info) & call psb_sp_trim(b,info)
endif
else if (check_=='R') then else if (check_=='R') then
!...Regenerating matrix !...Regenerating matrix

157
base/serial/psb_zspclip.f90
Unescape Escape View File

@ -0,0 +1,157 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: psb_zspclip.f90
! Subroutine: psb_zspclip
! Creates a "clipped" copy of input matrix A. Output is always in COO.
! Parameters:
!*****************************************************************************
!* *
!*****************************************************************************
subroutine psb_zspclip(a,b,info,imin,imax,jmin,jmax,rscale,cscale)
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, psb_protect_name => psb_zspclip
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_zspmat_type), intent(out) :: b
integer, intent(out) :: info
integer, intent(in), optional :: imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
integer :: lrw_, ierr(5), err_act
type(psb_zspmat_type) :: tmp
character(len=20) :: name, ch_err
integer :: imin_,imax_,jmin_,jmax_
logical :: rscale_,cscale_
integer :: sizeb, nzb, mb, kb, ifst, ilst, nrt, nzt, i, j
integer, parameter :: irbk=40, inzr=16
name='psb_zsp_clip'
info = 0
call psb_erractionsave(err_act)
call psb_set_erraction(0)
call psb_nullify_sp(b)
call psb_sp_all(tmp,inzr*irbk,info)
if (present(imin)) then
imin_ = imin
else
imin_ = 1
endif
if (present(imax)) then
imax_ = imax
else
imax_ = a%m
endif
if (present(jmin)) then
jmin_ = jmin
else
jmin_ = 1
endif
if (present(jmax)) then
jmax_ = jmax
else
jmax_ = a%k
endif
if (present(rscale)) then
rscale_ = rscale
else
rscale_ = .true.
endif
if (present(cscale)) then
cscale_ = cscale
else
cscale_ = .true.
endif
if (rscale_) then
mb = imax_ - imin_ +1
else
mb = a%m ! Should this be imax_ ??
endif
if (cscale_) then
kb = jmax_ - jmin_ +1
else
kb = a%k ! Should this be jmax_ ??
endif
sizeb = psb_sp_get_nnzeros(a)
call psb_sp_all(mb,kb,b,sizeb,info)
b%fida='COO'
nzb = 0
do i=imin_, imax_, irbk
nrt = min(irbk,imax_-i+1)
ifst = i
ilst = ifst + nrt - 1
call psb_sp_getblk(ifst,a,tmp,info,lrw=ilst)
nzt = psb_sp_get_nnzeros(tmp)
do j=1, nzt
if ((jmin_ <= tmp%ia2(j)).and.(tmp%ia2(j) <= jmax_)) then
nzb = nzb + 1
b%aspk(nzb) = tmp%aspk(j)
b%ia1(nzb) = tmp%ia1(j)
b%ia2(nzb) = tmp%ia2(j)
end if
end do
end do
b%infoa(psb_nnz_) = nzb
if (rscale_) then
do i=1, nzb
b%ia1(i) = b%ia1(i) - imin_ + 1
end do
end if
if (cscale_) then
do i=1, nzb
b%ia2(i) = b%ia2(i) - jmin_ + 1
end do
end if
call psb_fixcoo(b,info)
call psb_sp_trim(b,info)
call psb_sp_free(tmp,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_zspclip

22
base/serial/psb_zspgetrow.f90
Unescape Escape View File

@ -42,6 +42,7 @@
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw) subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type use psb_spmat_type
use psb_string_mod use psb_string_mod
use psb_serial_mod, psb_protect_name => psb_zspgetrow
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw integer, intent(in) :: irw
integer, intent(out) :: nz integer, intent(out) :: nz
@ -50,23 +51,6 @@ subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
integer, intent(in), target, optional :: iren(:) integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw integer, intent(in), optional :: lrw
integer, intent(out) :: info integer, intent(out) :: info
interface psb_spgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw)
! Output is always in COO format into B, irrespective of
! the input format
use psb_spmat_type
use psb_const_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
integer,intent(out) :: info
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
end subroutine psb_zspgtblk
end interface
integer :: lrw_, ierr(5), err_act integer :: lrw_, ierr(5), err_act
type(psb_zspmat_type) :: b type(psb_zspmat_type) :: b
@ -93,9 +77,9 @@ subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
call psb_sp_all(lrw_-irw+1,lrw_-irw+1,b,info) call psb_sp_all(lrw_-irw+1,lrw_-irw+1,b,info)
if (present(iren)) then if (present(iren)) then
call psb_spgtblk(irw,a,b,info,iren=iren,lrw=lrw_) call psb_sp_getblk(irw,a,b,info,iren=iren,lrw=lrw_)
else else
call psb_spgtblk(irw,a,b,info,lrw=lrw_) call psb_sp_getblk(irw,a,b,info,lrw=lrw_)
end if end if
if (info /= 0) then if (info /= 0) then
info=136 info=136

6
prec/psb_dbjac_bld.f90
Unescape Escape View File

@ -191,13 +191,11 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5
if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) call psb_sp_trim(p%av(u_pr_),info)
if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info)
endif endif
if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) call psb_sp_trim(p%av(l_pr_),info)
if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info)
endif endif

6
prec/psb_zbjac_bld.f90
Unescape Escape View File

@ -191,13 +191,11 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5
if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then
call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) call psb_sp_trim(p%av(u_pr_),info)
if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info)
endif endif
if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then
call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) call psb_sp_trim(p%av(l_pr_),info)
if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info)
endif endif

Write Preview
Loading…
Cancel
Save