From aafb62405ad6377546af98475b58e62b5ec87157 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 22 Feb 2007 15:06:14 +0000 Subject: [PATCH] Defining and using new routines: psb_sp_trim psb_sp_clip. --- Changelog | 5 + base/modules/psb_serial_mod.f90 | 532 +++++++++++++++++--------------- base/modules/psb_spmat_type.f90 | 53 ++++ base/serial/Makefile | 4 +- base/serial/psb_dcsdp.f90 | 6 +- base/serial/psb_dspclip.f90 | 157 ++++++++++ base/serial/psb_dspgetrow.f90 | 23 +- base/serial/psb_dspgtblk.f90 | 1 - base/serial/psb_zcsdp.f90 | 7 +- base/serial/psb_zspclip.f90 | 157 ++++++++++ base/serial/psb_zspgetrow.f90 | 22 +- prec/psb_dbjac_bld.f90 | 6 +- prec/psb_zbjac_bld.f90 | 6 +- 13 files changed, 666 insertions(+), 313 deletions(-) create mode 100644 base/serial/psb_dspclip.f90 create mode 100644 base/serial/psb_zspclip.f90 diff --git a/Changelog b/Changelog index 653fc161..68a47839 100644 --- a/Changelog +++ b/Changelog @@ -1,6 +1,11 @@ Changelog. A lot less detailed than usual, at least for past 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 allow compiling and running without mpi and blacs. Only diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index 489e4afb..e600d3d5 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -33,315 +33,335 @@ module psb_serial_mod use psb_string_mod interface psb_csdp - subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) - use psb_spmat_type - type(psb_dspmat_type), intent(in) :: a - type(psb_dspmat_type), intent(inout) :: b - integer, intent(out) :: info - integer, intent(in), optional :: ifc,upd,dupl - character, intent(in), optional :: check,trans,unitd - end subroutine psb_dcsdp - subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) - use psb_spmat_type - type(psb_zspmat_type), intent(in) :: a - type(psb_zspmat_type), intent(inout) :: b - integer, intent(out) :: info - integer, intent(in), optional :: ifc,upd,dupl - character, intent(in), optional :: check,trans,unitd - end subroutine psb_zcsdp + subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) + use psb_spmat_type + type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(inout) :: b + integer, intent(out) :: info + integer, intent(in), optional :: ifc,upd,dupl + character, intent(in), optional :: check,trans,unitd + end subroutine psb_dcsdp + subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) + use psb_spmat_type + type(psb_zspmat_type), intent(in) :: a + type(psb_zspmat_type), intent(inout) :: b + integer, intent(out) :: info + integer, intent(in), optional :: ifc,upd,dupl + character, intent(in), optional :: check,trans,unitd + end subroutine psb_zcsdp end interface interface psb_csrws - subroutine psb_dcsrws(rw,a,info,trans) - use psb_spmat_type - type(psb_dspmat_type) :: a - real(kind(1.d0)), allocatable :: rw(:) - integer :: info - character, optional :: trans - end subroutine psb_dcsrws - subroutine psb_zcsrws(rw,a,info,trans) - use psb_spmat_type - type(psb_zspmat_type) :: a - complex(kind(1.d0)), allocatable :: rw(:) - integer :: info - character, optional :: trans - end subroutine psb_zcsrws + subroutine psb_dcsrws(rw,a,info,trans) + use psb_spmat_type + type(psb_dspmat_type) :: a + real(kind(1.d0)), allocatable :: rw(:) + integer :: info + character, optional :: trans + end subroutine psb_dcsrws + subroutine psb_zcsrws(rw,a,info,trans) + use psb_spmat_type + type(psb_zspmat_type) :: a + complex(kind(1.d0)), allocatable :: rw(:) + integer :: info + character, optional :: trans + end subroutine psb_zcsrws end interface interface psb_cssm - subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) - use psb_spmat_type - type(psb_dspmat_type) :: t - real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) - integer :: info - character, optional :: trans, unitd - real(kind(1.d0)), optional, target :: d(:) - end subroutine psb_dcssm - subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) - use psb_spmat_type - type(psb_dspmat_type) :: t - real(kind(1.d0)) :: alpha, beta, b(:), c(:) - integer :: info - character, optional :: trans, unitd - real(kind(1.d0)), optional, target :: d(:) - end subroutine psb_dcssv - subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) - use psb_spmat_type - type(psb_zspmat_type) :: t - complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) - integer :: info - character, optional :: trans, unitd - complex(kind(1.d0)), optional, target :: d(:) - end subroutine psb_zcssm - subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) - use psb_spmat_type - type(psb_zspmat_type) :: t - complex(kind(1.d0)) :: alpha, beta, b(:), c(:) - integer :: info - character, optional :: trans, unitd - complex(kind(1.d0)), optional, target :: d(:) - end subroutine psb_zcssv + subroutine psb_dcssm(alpha,t,b,beta,c,info,trans,unitd,d) + use psb_spmat_type + type(psb_dspmat_type) :: t + real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) + integer :: info + character, optional :: trans, unitd + real(kind(1.d0)), optional, target :: d(:) + end subroutine psb_dcssm + subroutine psb_dcssv(alpha,t,b,beta,c,info,trans,unitd,d) + use psb_spmat_type + type(psb_dspmat_type) :: t + real(kind(1.d0)) :: alpha, beta, b(:), c(:) + integer :: info + character, optional :: trans, unitd + real(kind(1.d0)), optional, target :: d(:) + end subroutine psb_dcssv + subroutine psb_zcssm(alpha,t,b,beta,c,info,trans,unitd,d) + use psb_spmat_type + type(psb_zspmat_type) :: t + complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) + integer :: info + character, optional :: trans, unitd + complex(kind(1.d0)), optional, target :: d(:) + end subroutine psb_zcssm + subroutine psb_zcssv(alpha,t,b,beta,c,info,trans,unitd,d) + use psb_spmat_type + type(psb_zspmat_type) :: t + complex(kind(1.d0)) :: alpha, beta, b(:), c(:) + integer :: info + character, optional :: trans, unitd + complex(kind(1.d0)), optional, target :: d(:) + end subroutine psb_zcssv end interface interface psb_csmm - subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) - use psb_spmat_type - type(psb_dspmat_type) :: a - real(kind(1.d0)) :: alpha, beta, b(:), c(:) - integer :: info - character, optional :: trans - end subroutine psb_dcsmv - subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) - use psb_spmat_type - type(psb_dspmat_type) :: a - real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) - integer :: info - character, optional :: trans - end subroutine psb_dcsmm - subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans) - use psb_spmat_type - type(psb_zspmat_type) :: a - complex(kind(1.d0)) :: alpha, beta, b(:), c(:) - integer :: info - character, optional :: trans - end subroutine psb_zcsmv - subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans) - use psb_spmat_type - type(psb_zspmat_type) :: a - complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) - integer :: info - character, optional :: trans - end subroutine psb_zcsmm + subroutine psb_dcsmv(alpha,a,b,beta,c,info,trans) + use psb_spmat_type + type(psb_dspmat_type) :: a + real(kind(1.d0)) :: alpha, beta, b(:), c(:) + integer :: info + character, optional :: trans + end subroutine psb_dcsmv + subroutine psb_dcsmm(alpha,a,b,beta,c,info,trans) + use psb_spmat_type + type(psb_dspmat_type) :: a + real(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) + integer :: info + character, optional :: trans + end subroutine psb_dcsmm + subroutine psb_zcsmv(alpha,a,b,beta,c,info,trans) + use psb_spmat_type + type(psb_zspmat_type) :: a + complex(kind(1.d0)) :: alpha, beta, b(:), c(:) + integer :: info + character, optional :: trans + end subroutine psb_zcsmv + subroutine psb_zcsmm(alpha,a,b,beta,c,info,trans) + use psb_spmat_type + type(psb_zspmat_type) :: a + complex(kind(1.d0)) :: alpha, beta, b(:,:), c(:,:) + integer :: info + character, optional :: trans + end subroutine psb_zcsmm end interface interface psb_fixcoo - subroutine psb_dfixcoo(a,info,idir) - use psb_spmat_type - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: idir - end subroutine psb_dfixcoo - subroutine psb_zfixcoo(a,info,idir) - use psb_spmat_type - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: idir - end subroutine psb_zfixcoo + subroutine psb_dfixcoo(a,info,idir) + use psb_spmat_type + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, intent(in), optional :: idir + end subroutine psb_dfixcoo + subroutine psb_zfixcoo(a,info,idir) + use psb_spmat_type + type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, intent(in), optional :: idir + end subroutine psb_zfixcoo end interface interface psb_ipcoo2csr - subroutine psb_dipcoo2csr(a,info,rwshr) - use psb_spmat_type - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: rwshr - end subroutine psb_dipcoo2csr - subroutine psb_zipcoo2csr(a,info,rwshr) - use psb_spmat_type - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: rwshr - end subroutine psb_zipcoo2csr + subroutine psb_dipcoo2csr(a,info,rwshr) + use psb_spmat_type + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + logical, optional :: rwshr + end subroutine psb_dipcoo2csr + subroutine psb_zipcoo2csr(a,info,rwshr) + use psb_spmat_type + type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + logical, optional :: rwshr + end subroutine psb_zipcoo2csr end interface interface psb_ipcoo2csc - subroutine psb_dipcoo2csc(a,info,clshr) - use psb_spmat_type - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: clshr - end subroutine psb_dipcoo2csc - subroutine psb_zipcoo2csc(a,info,clshr) - use psb_spmat_type - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - logical, optional :: clshr - end subroutine psb_zipcoo2csc + subroutine psb_dipcoo2csc(a,info,clshr) + use psb_spmat_type + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + logical, optional :: clshr + end subroutine psb_dipcoo2csc + subroutine psb_zipcoo2csc(a,info,clshr) + use psb_spmat_type + type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + logical, optional :: clshr + end subroutine psb_zipcoo2csc end interface interface psb_ipcsr2coo - subroutine psb_dipcsr2coo(a,info) - use psb_spmat_type - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_dipcsr2coo - subroutine psb_zipcsr2coo(a,info) - use psb_spmat_type - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - end subroutine psb_zipcsr2coo + subroutine psb_dipcsr2coo(a,info) + use psb_spmat_type + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + end subroutine psb_dipcsr2coo + subroutine psb_zipcsr2coo(a,info) + use psb_spmat_type + type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + end subroutine psb_zipcsr2coo end interface interface psb_csprt - subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type - integer, intent(in) :: iout - type(psb_dspmat_type), intent(in) :: a - integer, intent(in), optional :: iv(:) - integer, intent(in), optional :: irs,ics - character(len=*), optional :: head - integer, intent(in), optional :: ivr(:),ivc(:) - end subroutine psb_dcsprt - subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) - use psb_spmat_type - integer, intent(in) :: iout - type(psb_zspmat_type), intent(in) :: a - integer, intent(in), optional :: iv(:) - integer, intent(in), optional :: irs,ics - character(len=*), optional :: head - integer, intent(in), optional :: ivr(:),ivc(:) - end subroutine psb_zcsprt + subroutine psb_dcsprt(iout,a,iv,irs,ics,head,ivr,ivc) + use psb_spmat_type + integer, intent(in) :: iout + type(psb_dspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: irs,ics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:),ivc(:) + end subroutine psb_dcsprt + subroutine psb_zcsprt(iout,a,iv,irs,ics,head,ivr,ivc) + use psb_spmat_type + integer, intent(in) :: iout + type(psb_zspmat_type), intent(in) :: a + integer, intent(in), optional :: iv(:) + integer, intent(in), optional :: irs,ics + character(len=*), optional :: head + integer, intent(in), optional :: ivr(:),ivc(:) + end subroutine psb_zcsprt end interface interface psb_neigh - subroutine psb_dneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type - type(psb_dspmat_type), intent(in) :: a - integer, intent(in) :: idx - integer, intent(out) :: n - integer, allocatable :: neigh(:) - integer, intent(out) :: info - integer, optional, intent(in) :: lev - end subroutine psb_dneigh - subroutine psb_zneigh(a,idx,neigh,n,info,lev) - use psb_spmat_type - type(psb_zspmat_type), intent(in) :: a - integer, intent(in) :: idx - integer, intent(out) :: n - integer, allocatable :: neigh(:) - integer, intent(out) :: info - integer, optional, intent(in) :: lev - end subroutine psb_zneigh + subroutine psb_dneigh(a,idx,neigh,n,info,lev) + use psb_spmat_type + type(psb_dspmat_type), intent(in) :: a + integer, intent(in) :: idx + integer, intent(out) :: n + integer, allocatable :: neigh(:) + integer, intent(out) :: info + integer, optional, intent(in) :: lev + end subroutine psb_dneigh + subroutine psb_zneigh(a,idx,neigh,n,info,lev) + use psb_spmat_type + type(psb_zspmat_type), intent(in) :: a + integer, intent(in) :: idx + integer, intent(out) :: n + integer, allocatable :: neigh(:) + integer, intent(out) :: info + integer, optional, intent(in) :: lev + end subroutine psb_zneigh end interface interface psb_coins - subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type - integer, intent(in) :: nz, imin,imax,jmin,jmax - integer, intent(in) :: ia(:),ja(:) - real(kind(1.d0)), intent(in) :: val(:) - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: gtl(:) - logical, optional, intent(in) :: rebuild - end subroutine psb_dcoins - subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) - use psb_spmat_type - integer, intent(in) :: nz, imin,imax,jmin,jmax - integer, intent(in) :: ia(:),ja(:) - complex(kind(1.d0)), intent(in) :: val(:) - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - integer, intent(in), optional :: gtl(:) - logical, optional, intent(in) :: rebuild - end subroutine psb_zcoins + subroutine psb_dcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) + use psb_spmat_type + integer, intent(in) :: nz, imin,imax,jmin,jmax + integer, intent(in) :: ia(:),ja(:) + real(kind(1.d0)), intent(in) :: val(:) + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, intent(in), optional :: gtl(:) + logical, optional, intent(in) :: rebuild + end subroutine psb_dcoins + subroutine psb_zcoins(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl,rebuild) + use psb_spmat_type + integer, intent(in) :: nz, imin,imax,jmin,jmax + integer, intent(in) :: ia(:),ja(:) + complex(kind(1.d0)), intent(in) :: val(:) + type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + integer, intent(in), optional :: gtl(:) + logical, optional, intent(in) :: rebuild + end subroutine psb_zcoins end interface interface psb_symbmm - subroutine psb_dsymbmm(a,b,c,info) - use psb_spmat_type - type(psb_dspmat_type) :: a,b,c - integer :: info - end subroutine psb_dsymbmm - subroutine psb_zsymbmm(a,b,c,info) - use psb_spmat_type - type(psb_zspmat_type) :: a,b,c - integer :: info - end subroutine psb_zsymbmm + subroutine psb_dsymbmm(a,b,c,info) + use psb_spmat_type + type(psb_dspmat_type) :: a,b,c + integer :: info + end subroutine psb_dsymbmm + subroutine psb_zsymbmm(a,b,c,info) + use psb_spmat_type + type(psb_zspmat_type) :: a,b,c + integer :: info + end subroutine psb_zsymbmm end interface interface psb_numbmm - subroutine psb_dnumbmm(a,b,c) - use psb_spmat_type - type(psb_dspmat_type) :: a,b,c - end subroutine psb_dnumbmm - subroutine psb_znumbmm(a,b,c) - use psb_spmat_type - type(psb_zspmat_type) :: a,b,c - end subroutine psb_znumbmm + subroutine psb_dnumbmm(a,b,c) + use psb_spmat_type + type(psb_dspmat_type) :: a,b,c + end subroutine psb_dnumbmm + subroutine psb_znumbmm(a,b,c) + use psb_spmat_type + type(psb_zspmat_type) :: a,b,c + end subroutine psb_znumbmm end interface interface psb_transp - subroutine psb_dtransp(a,b,c,fmt) - use psb_spmat_type - type(psb_dspmat_type) :: a,b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_dtransp - subroutine psb_ztransp(a,b,c,fmt) - use psb_spmat_type - type(psb_zspmat_type) :: a,b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ztransp + subroutine psb_dtransp(a,b,c,fmt) + use psb_spmat_type + type(psb_dspmat_type) :: a,b + integer, optional :: c + character(len=*), optional :: fmt + end subroutine psb_dtransp + subroutine psb_ztransp(a,b,c,fmt) + use psb_spmat_type + type(psb_zspmat_type) :: a,b + integer, optional :: c + character(len=*), optional :: fmt + end subroutine psb_ztransp end interface interface psb_transc - subroutine psb_ztransc(a,b,c,fmt) - use psb_spmat_type - type(psb_zspmat_type) :: a,b - integer, optional :: c - character(len=*), optional :: fmt - end subroutine psb_ztransc + subroutine psb_ztransc(a,b,c,fmt) + use psb_spmat_type + type(psb_zspmat_type) :: a,b + integer, optional :: c + character(len=*), optional :: fmt + end subroutine psb_ztransc end interface interface psb_rwextd - subroutine psb_drwextd(nr,a,info,b,rowscale) - use psb_spmat_type - integer, intent(in) :: nr - type(psb_dspmat_type), intent(inout) :: a - integer, intent(out) :: info - type(psb_dspmat_type), intent(in), optional :: b - logical, intent(in), optional :: rowscale - end subroutine psb_drwextd - subroutine psb_zrwextd(nr,a,info,b,rowscale) - use psb_spmat_type - integer, intent(in) :: nr - type(psb_zspmat_type), intent(inout) :: a - integer, intent(out) :: info - type(psb_zspmat_type), intent(in), optional :: b - logical, intent(in), optional :: rowscale - end subroutine psb_zrwextd + subroutine psb_drwextd(nr,a,info,b,rowscale) + use psb_spmat_type + integer, intent(in) :: nr + type(psb_dspmat_type), intent(inout) :: a + integer, intent(out) :: info + type(psb_dspmat_type), intent(in), optional :: b + logical, intent(in), optional :: rowscale + end subroutine psb_drwextd + subroutine psb_zrwextd(nr,a,info,b,rowscale) + use psb_spmat_type + integer, intent(in) :: nr + type(psb_zspmat_type), intent(inout) :: a + integer, intent(out) :: info + type(psb_zspmat_type), intent(in), optional :: b + logical, intent(in), optional :: rowscale + end subroutine psb_zrwextd end interface interface psb_csnmi - real(kind(1.d0)) function psb_dcsnmi(a,info,trans) - use psb_spmat_type - type(psb_dspmat_type), intent(in) :: a - integer, intent(out) :: info - character, optional :: trans - end function psb_dcsnmi - real(kind(1.d0)) function psb_zcsnmi(a,info,trans) - use psb_spmat_type - type(psb_zspmat_type), intent(in) :: a - integer, intent(out) :: info - character, optional :: trans - end function psb_zcsnmi + real(kind(1.d0)) function psb_dcsnmi(a,info,trans) + use psb_spmat_type + type(psb_dspmat_type), intent(in) :: a + integer, intent(out) :: info + character, optional :: trans + end function psb_dcsnmi + real(kind(1.d0)) function psb_zcsnmi(a,info,trans) + use psb_spmat_type + type(psb_zspmat_type), intent(in) :: a + integer, intent(out) :: info + character, optional :: trans + end function psb_zcsnmi 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 subroutine psb_dspgtdiag(a,d,info) diff --git a/base/modules/psb_spmat_type.f90 b/base/modules/psb_spmat_type.f90 index 7c8f6d3a..670f5a98 100644 --- a/base/modules/psb_spmat_type.f90 +++ b/base/modules/psb_spmat_type.f90 @@ -127,6 +127,10 @@ module psb_spmat_type module procedure psb_dsp_transfer, psb_zsp_transfer end interface + interface psb_sp_trim + module procedure psb_dsp_trim, psb_zsp_trim + end interface + interface psb_sp_trimsize module procedure psb_dsp_trimsize, psb_zsp_trimsize end interface @@ -643,6 +647,55 @@ contains 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) use psb_string_mod implicit none diff --git a/base/serial/Makefile b/base/serial/Makefile index a20f14d4..c4bbd8e3 100644 --- a/base/serial/Makefile +++ b/base/serial/Makefile @@ -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_dfixcoo.o psb_dipcoo2csr.o psb_dipcsr2coo.o psb_dneigh.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_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_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_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 LIBDIR = .. diff --git a/base/serial/psb_dcsdp.f90 b/base/serial/psb_dcsdp.f90 index 9e5c0fcd..d7e4470f 100644 --- a/base/serial/psb_dcsdp.f90 +++ b/base/serial/psb_dcsdp.f90 @@ -388,10 +388,8 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) end select - if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then - call psb_sp_trimsize(b,i1,i2,ia,info) - if (info == 0) call psb_sp_reall(b,i1,i2,ia,info) - endif + if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) & + & call psb_sp_trim(b,info) else if (check_=='R') then diff --git a/base/serial/psb_dspclip.f90 b/base/serial/psb_dspclip.f90 new file mode 100644 index 00000000..0ef468dd --- /dev/null +++ b/base/serial/psb_dspclip.f90 @@ -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 + diff --git a/base/serial/psb_dspgetrow.f90 b/base/serial/psb_dspgetrow.f90 index 31edd440..a0cf2ab4 100644 --- a/base/serial/psb_dspgetrow.f90 +++ b/base/serial/psb_dspgetrow.f90 @@ -42,6 +42,8 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw) use psb_spmat_type use psb_string_mod + use psb_serial_mod, psb_protect_name => psb_dspgetrow + type(psb_dspmat_type), intent(in) :: a integer, intent(in) :: irw 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), optional :: lrw 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 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) 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 - call psb_spgtblk(irw,a,b,info,lrw=lrw_) + call psb_sp_getblk(irw,a,b,info,lrw=lrw_) end if if (info /= 0) then info=136 diff --git a/base/serial/psb_dspgtblk.f90 b/base/serial/psb_dspgtblk.f90 index 933b441c..09dddf30 100644 --- a/base/serial/psb_dspgtblk.f90 +++ b/base/serial/psb_dspgtblk.f90 @@ -32,7 +32,6 @@ ! Subroutine: psb_dspgtblk ! Gets one or more rows from a sparse matrix. ! Parameters: - !***************************************************************************** !* * !* Takes a specified row from matrix A and copies into matrix B (possibly * diff --git a/base/serial/psb_zcsdp.f90 b/base/serial/psb_zcsdp.f90 index 4a196cb7..6bfec0c0 100644 --- a/base/serial/psb_zcsdp.f90 +++ b/base/serial/psb_zcsdp.f90 @@ -389,10 +389,9 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl) end select - if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) then - call psb_sp_trimsize(b,i1,i2,ia,info) - if (info == 0) call psb_sp_reall(b,i1,i2,ia,info) - endif + + if (psb_sp_getifld(psb_upd_,b,info) /= psb_upd_perm_) & + & call psb_sp_trim(b,info) else if (check_=='R') then !...Regenerating matrix diff --git a/base/serial/psb_zspclip.f90 b/base/serial/psb_zspclip.f90 new file mode 100644 index 00000000..0f6e9c16 --- /dev/null +++ b/base/serial/psb_zspclip.f90 @@ -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 + diff --git a/base/serial/psb_zspgetrow.f90 b/base/serial/psb_zspgetrow.f90 index 073b56ed..d481e102 100644 --- a/base/serial/psb_zspgetrow.f90 +++ b/base/serial/psb_zspgetrow.f90 @@ -42,6 +42,7 @@ subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw) use psb_spmat_type use psb_string_mod + use psb_serial_mod, psb_protect_name => psb_zspgetrow type(psb_zspmat_type), intent(in) :: a integer, intent(in) :: irw 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), optional :: lrw 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 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) 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 - call psb_spgtblk(irw,a,b,info,lrw=lrw_) + call psb_sp_getblk(irw,a,b,info,lrw=lrw_) end if if (info /= 0) then info=136 diff --git a/prec/psb_dbjac_bld.f90 b/prec/psb_dbjac_bld.f90 index ad30149c..f41756a2 100644 --- a/prec/psb_dbjac_bld.f90 +++ b/prec/psb_dbjac_bld.f90 @@ -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 (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) - if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) + call psb_sp_trim(p%av(u_pr_),info) endif 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) - if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) + call psb_sp_trim(p%av(l_pr_),info) endif diff --git a/prec/psb_zbjac_bld.f90 b/prec/psb_zbjac_bld.f90 index dad3ca86..2b692d5a 100644 --- a/prec/psb_zbjac_bld.f90 +++ b/prec/psb_zbjac_bld.f90 @@ -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 (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) - if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) + call psb_sp_trim(p%av(u_pr_),info) endif 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) - if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) + call psb_sp_trim(p%av(l_pr_),info) endif