fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 10:52:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed interface use, insert use statements wherever possible.

Browse Source
This commit is contained in:
Salvatore Filippone
2006-12-05 12:07:42 +00:00
parent e776f419f7
commit 05721fa5fd
43 changed files with 814 additions and 1400 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Changelog
+3
View File
@@ -1,6 +1,9 @@
Changelog. A lot less detailed than usual, at least for past
history.
2006/12/05: Taken out extra interfaces; inserted use modules with ONLY
clauses where appropriate.
2006/11/30: Fixed a bug in raw aggregation. Note: raw aggregation
gives different results from smoothed with omega=0.0,
because in the latter we have explicitly stored zero
src/internals/psi_crea_index.f90
+1 -27
View File
@@ -34,6 +34,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
use psb_descriptor_type
use psb_error_mod
use psb_penv_mod
use psi_mod, only: psi_sort_dl, psi_desc_index, psi_dl_check
implicit none
type(psb_desc_type), intent(in) :: desc_a
@@ -50,33 +51,6 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info
logical,parameter :: debug=.false.
character(len=20) :: name
interface
subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
integer :: np,dep_list(:,:), l_dep_list(:), info
end subroutine psi_sort_dl
end interface
interface
subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
integer :: np,dl_lda,length_dl(0:np)
integer :: dep_list(dl_lda,0:np)
end subroutine psi_dl_check
end interface
interface
subroutine psi_desc_index(desc,index_in,dep_list,&
& length_dl,nsnd,nrcv,desc_index,&
& isglob_in,info)
use psb_descriptor_type
type(psb_desc_type) :: desc
integer :: index_in(:),dep_list(:)
integer, allocatable :: desc_index(:)
integer :: length_dl,nsnd,nrcv,info
logical :: isglob_in
end subroutine psi_desc_index
end interface
info = 0
name='psi_crea_index'
call psb_erractionsave(err_act)
src/modules/psb_prec_mod.f90
+305
View File
@@ -201,4 +201,309 @@ module psb_prec_mod
end interface
interface psb_baseprc_aply
subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:), y(:)
real(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dbaseprc_aply
subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: prec
complex(kind(1.d0)),intent(inout) :: x(:), y(:)
complex(kind(1.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
complex(kind(1.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zbaseprc_aply
end interface
interface psb_mlprc_aply
subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: baseprecv(:)
real(kind(0.d0)),intent(in) :: alpha,beta
real(kind(0.d0)),intent(inout) :: x(:), y(:)
character :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dmlprc_aply
subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: baseprecv(:)
complex(kind(0.d0)),intent(in) :: alpha,beta
complex(kind(0.d0)),intent(inout) :: x(:), y(:)
character :: trans
complex(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zmlprc_aply
end interface
interface psb_bjac_aply
subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:), y(:)
real(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dbjac_aply
subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: prec
complex(kind(0.d0)),intent(inout) :: x(:), y(:)
complex(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
complex(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zbjac_aply
end interface
interface psb_diagsc_bld
subroutine psb_ddiagsc_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_ddiagsc_bld
subroutine psb_zdiagsc_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_zdiagsc_bld
end interface
interface psb_ilu_bld
subroutine psb_dilu_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_dilu_bld
subroutine psb_zilu_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_zilu_bld
end interface
interface psb_slu_bld
subroutine psb_dslu_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_dslu_bld
subroutine psb_zslu_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_zspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_zslu_bld
end interface
interface psb_umf_bld
subroutine psb_dumf_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_dumf_bld
subroutine psb_zumf_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_zumf_bld
end interface
interface psb_ilu_fct
subroutine psb_dilu_fct(a,l,u,d,info,blck)
use psb_spmat_type
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck
real(kind(1.d0)), intent(inout) :: d(:)
end subroutine psb_dilu_fct
subroutine psb_zilu_fct(a,l,u,d,info,blck)
use psb_spmat_type
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck
complex(kind(1.d0)), intent(inout) :: d(:)
end subroutine psb_zilu_fct
end interface
interface psb_as_matbld
Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_dasmatbld
Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_zasmatbld
end interface
interface psb_sp_renum
subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
implicit none
! .. array Arguments ..
type(psb_dspmat_type), intent(in) :: a,blck
type(psb_dspmat_type), intent(inout) :: atmp
type(psb_dbaseprc_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
end subroutine psb_dsp_renum
subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
implicit none
! .. array Arguments ..
type(psb_zspmat_type), intent(in) :: a,blck
type(psb_zspmat_type), intent(inout) :: atmp
type(psb_zbaseprc_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
end subroutine psb_zsp_renum
end interface
interface psb_genaggrmap
subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_spmat_type
use psb_descriptor_type
implicit none
integer, intent(in) :: aggr_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
end subroutine psb_dgenaggrmap
subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_spmat_type
use psb_descriptor_type
implicit none
integer, intent(in) :: aggr_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
end subroutine psb_zgenaggrmap
end interface
interface psb_bldaggrmat
subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(out),target :: ac
type(psb_desc_type), intent(inout) :: desc_ac
type(psb_dbaseprc_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine psb_dbldaggrmat
subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zbaseprc_type), intent(inout),target :: p
type(psb_zspmat_type), intent(out),target :: ac
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_ac
integer, intent(out) :: info
end subroutine psb_zbldaggrmat
end interface
end module psb_prec_mod
src/modules/psb_serial_mod.f90
+361 -322
View File
@@ -33,394 +33,433 @@ 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)
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
end subroutine psb_drwextd
subroutine psb_zrwextd(nr,a,info,b)
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
end subroutine psb_zrwextd
subroutine psb_drwextd(nr,a,info,b)
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
end subroutine psb_drwextd
subroutine psb_zrwextd(nr,a,info,b)
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
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_getdiag
subroutine psb_dspgtdiag(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
real(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspgtdiag
subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
complex(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspgtdiag
subroutine psb_dspgtdiag(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
real(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspgtdiag
subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
complex(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspgtdiag
end interface
interface psb_sp_scal
subroutine psb_dspscal(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a
real(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspscal
subroutine psb_zspscal(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a
complex(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspscal
subroutine psb_dspscal(a,d,info)
use psb_spmat_type
type(psb_dspmat_type), intent(inout) :: a
real(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_dspscal
subroutine psb_zspscal(a,d,info)
use psb_spmat_type
type(psb_zspmat_type), intent(inout) :: a
complex(kind(1.d0)), intent(in) :: d(:)
integer, intent(out) :: info
end subroutine psb_zspscal
end interface
interface psb_sp_getblk
subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_dspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgtblk
subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_dspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgtblk
end interface
interface psb_sp_getrow
subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
real(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgetrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
complex(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgetrow
subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
real(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgetrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
complex(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgetrow
end interface
interface csrp
subroutine dcsrp(trans,m,n,fida,descra,ia1,ia2,&
& infoa,p,work,lwork,ierror)
integer, intent(in) :: m, n, lwork
integer, intent(out) :: ierror
character, intent(in) :: trans
double precision, intent(inout) :: work(*)
integer, intent(in) :: p(*)
integer, intent(inout) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine dcsrp
subroutine zcsrp(trans,m,n,fida,descra,ia1,ia2,&
& infoa,p,work,lwork,ierror)
integer, intent(in) :: m, n, lwork
integer, intent(out) :: ierror
character, intent(in) :: trans
complex(kind(1.d0)), intent(inout) :: work(*)
integer, intent(in) :: p(*)
integer, intent(inout) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine zcsrp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
character(len=5) :: afmt
end subroutine psb_cest
end interface
end module psb_serial_mod
src/modules/psi_mod.f90
+16 -9
View File
@@ -77,15 +77,15 @@ module psi_mod
end interface
interface
subroutine psi_desc_index(desc_data,index_in,dep_list,&
& length_dl,nsnd,nrcv,loc_to_glob,glob_to_loc,desc_index,&
& isglob_in,info)
integer :: desc_data(:),index_in(:),dep_list(:)
integer :: loc_to_glob(:),glob_to_loc(:)
integer,allocatable, intent(inout) :: desc_index(:)
integer :: length_dl,nsnd,nrcv,info
logical :: isglob_in
end subroutine psi_desc_index
subroutine psi_desc_index(desc,index_in,dep_list,&
& length_dl,nsnd,nrcv,desc_index,isglob_in,info)
use psb_descriptor_type
type(psb_desc_type) :: desc
integer :: index_in(:),dep_list(:)
integer,allocatable :: desc_index(:)
integer :: length_dl,nsnd,nrcv,info
logical :: isglob_in
end subroutine psi_desc_index
end interface
interface
@@ -94,6 +94,13 @@ module psi_mod
end subroutine psi_sort_dl
end interface
interface
subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
integer :: np,dl_lda,length_dl(0:np)
integer :: dep_list(dl_lda,0:np)
end subroutine psi_dl_check
end interface
interface psi_swapdata
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
use psb_descriptor_type
src/prec/psb_dbaseprc_aply.f90
+1 -13
View File
@@ -47,6 +47,7 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod, only : psb_bjac_aply
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -67,19 +68,6 @@ subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
external mpi_wtime
character(len=20) :: name, ch_err
interface psb_bjac_aply
subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:), y(:)
real(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dbjac_aply
end interface
name='psb_dbaseprc_aply'
info = 0
src/prec/psb_dbaseprc_bld.f90
+2 -55
View File
@@ -46,6 +46,8 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
use psb_psblas_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
Implicit None
type(psb_dspmat_type), target :: a
@@ -54,61 +56,6 @@ subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
integer, intent(out) :: info
character, intent(in), optional :: upd
interface psb_diagsc_bld
subroutine psb_ddiagsc_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_ddiagsc_bld
end interface
interface psb_ilu_bld
subroutine psb_dilu_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_dilu_bld
end interface
interface psb_slu_bld
subroutine psb_dslu_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_dslu_bld
end interface
interface psb_umf_bld
subroutine psb_dumf_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_dspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_dumf_bld
end interface
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
src/prec/psb_dilu_bld.f90
+6 -48
View File
@@ -60,6 +60,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
use psb_error_mod
use psb_realloc_mod
use psb_penv_mod
use psb_prec_mod
implicit none
!
! .. Scalar Arguments ..
@@ -83,49 +84,6 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
integer :: ictxt,np,me
character(len=20) :: name, ch_err
interface psb_ilu_fct
subroutine psb_dilu_fct(a,l,u,d,info,blck)
use psb_spmat_type
integer, intent(out) :: info
type(psb_dspmat_type),intent(in) :: a
type(psb_dspmat_type),intent(inout) :: l,u
type(psb_dspmat_type),intent(in), optional, target :: blck
real(kind(1.d0)), intent(inout) :: d(:)
end subroutine psb_dilu_fct
end interface
interface psb_asmatbld
Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_dasmatbld
end interface
interface psb_sp_renum
subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
implicit none
! .. array Arguments ..
type(psb_dspmat_type), intent(in) :: a,blck
type(psb_dspmat_type), intent(inout) :: atmp
type(psb_dbaseprc_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
end subroutine psb_dsp_renum
end interface
if(psb_get_errstatus().ne.0) return
info=0
name='psb_ilu_bld'
@@ -157,18 +115,18 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
t1= mpi_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if(debug) write(0,*)me,': calling psb_as_matbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call psb_barrier(ictxt)
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
call psb_as_matbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info)
if(info/=0) then
info=4010
ch_err='psb_asmatbld'
ch_err='psb_as_matbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
t2= mpi_wtime()
if (debug) write(0,*)me,': out of psb_asmatbld'
if (debug) write(0,*)me,': out of psb_as_matbld'
if (debug) call psb_barrier(ictxt)
if (allocated(p%av)) then
@@ -220,7 +178,7 @@ subroutine psb_dilu_bld(a,desc_a,p,upd,info)
if (debug) then
write(0,*) me,'Done psb_asmatbld'
write(0,*) me,'Done psb_as_matbld'
call psb_barrier(ictxt)
endif
src/prec/psb_dmlprc_aply.f90
+1 -14
View File
@@ -91,6 +91,7 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod, only : psb_baseprc_aply
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -119,20 +120,6 @@ subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
end type psb_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
interface psb_baseprc_aply
subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:), y(:)
real(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dbaseprc_aply
end interface
name='psb_mlprc_aply'
info = 0
call psb_erractionsave(err_act)
src/prec/psb_dmlprc_bld.f90
+1 -39
View File
@@ -43,6 +43,7 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_dspmat_type), intent(in), target :: a
@@ -57,45 +58,6 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
type(psb_dspmat_type) :: ac
interface psb_baseprc_bld
subroutine psb_dbaseprc_bld(a,desc_a,p,info,upd)
Use psb_spmat_type
use psb_descriptor_type
use psb_prec_type
type(psb_dspmat_type), target :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine psb_dbaseprc_bld
end interface
interface psb_genaggrmap
subroutine psb_dgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_spmat_type
use psb_descriptor_type
implicit none
integer, intent(in) :: aggr_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
end subroutine psb_dgenaggrmap
end interface
interface psb_bldaggrmat
subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_dspmat_type), intent(out),target :: ac
type(psb_desc_type), intent(inout) :: desc_ac
type(psb_dbaseprc_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine psb_dbldaggrmat
end interface
integer :: ictxt, np, me
src/prec/psb_dprc_aply.f90
+3 -44
View File
@@ -43,6 +43,7 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -60,34 +61,6 @@ subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
external mpi_wtime
character(len=20) :: name
interface psb_baseprc_aply
subroutine psb_dbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:), y(:)
real(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dbaseprc_aply
end interface
interface psb_mlprc_aply
subroutine psb_dmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_dbaseprc_type), intent(in) :: baseprecv(:)
real(kind(0.d0)),intent(in) :: alpha,beta
real(kind(0.d0)),intent(inout) :: x(:), y(:)
character :: trans
real(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_dmlprc_aply
end interface
name='psb_dprc_aply'
info = 0
call psb_erractionsave(err_act)
@@ -193,6 +166,7 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -202,21 +176,6 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
logical,parameter :: debug=.false., debugprt=.false.
interface
subroutine psb_dprc_aply(prec,x,y,desc_data,info,trans, work)
use psb_descriptor_type
use psb_prec_type
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(psb_dprec_type), intent(in) :: prec
real(kind(0.d0)),intent(inout) :: x(:), y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
real(kind(0.d0)), optional, target :: work(:)
end subroutine psb_dprc_aply
end interface
! Local variables
character :: trans_
@@ -242,7 +201,7 @@ subroutine psb_dprc_aply1(prec,x,desc_data,info,trans)
goto 9999
end if
if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1)
call psb_dprc_aply(prec,x,ww,desc_data,info,trans_,work=w1)
call psb_prc_aply(prec,x,ww,desc_data,info,trans_,work=w1)
if(info /=0) goto 9999
x(:) = ww(:)
deallocate(ww,W1)
src/prec/psb_dslu_bld.f90
+4 -19
View File
@@ -41,6 +41,7 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
use psb_tools_mod
use psb_const_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_dspmat_type), intent(inout) :: a
@@ -56,22 +57,6 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_asmatbld
Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_dasmatbld
end interface
if(psb_get_errstatus().ne.0) return
info=0
name='psb_slu_bld'
@@ -103,18 +88,18 @@ subroutine psb_dslu_bld(a,desc_a,p,info)
write(0,*) me, 'SPLUBLD: Done csdp',info,nza,atmp%m,atmp%k
call psb_barrier(ictxt)
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
call psb_as_matbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
if(info /= 0) then
info=4010
ch_err='psb_asmatbld'
ch_err='psb_as_matbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzb = blck%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done asmatbld',info,nzb,blck%fida
write(0,*) me, 'SPLUBLD: Done as_matbld',info,nzb,blck%fida
call psb_barrier(ictxt)
endif
if (nzb > 0 ) then
src/prec/psb_dumf_bld.f90
+4 -19
View File
@@ -41,6 +41,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
use psb_tools_mod
use psb_const_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_dspmat_type), intent(inout) :: a
@@ -57,22 +58,6 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_asmatbld
Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_dspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_dasmatbld
end interface
info=0
name='psb_umf_bld'
call psb_erractionsave(err_act)
@@ -104,18 +89,18 @@ subroutine psb_dumf_bld(a,desc_a,p,info)
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call psb_barrier(ictxt)
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
call psb_as_matbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
if(info /= 0) then
info=4010
ch_err='psb_asmatbld'
ch_err='psb_as_matbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzb = psb_sp_get_nnzeros(blck)
if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
write(0,*) me, 'UMFBLD: Done as_matbld',info,nzb,blck%fida
call psb_barrier(ictxt)
endif
if (nzb > 0 ) then
src/prec/psb_zbaseprc_aply.f90
+1 -14
View File
@@ -47,6 +47,7 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod, only : psb_bjac_aply
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -67,20 +68,6 @@ subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
external mpi_wtime
character(len=20) :: name, ch_err
interface psb_bjac_aply
subroutine psb_zbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type), intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: prec
complex(kind(0.d0)),intent(inout) :: x(:), y(:)
complex(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
complex(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zbjac_aply
end interface
name='psb_zbaseprc_aply'
info = 0
call psb_erractionsave(err_act)
src/prec/psb_zbaseprc_bld.f90
+1 -55
View File
@@ -46,6 +46,7 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
use psb_psblas_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
Implicit None
type(psb_zspmat_type), target :: a
@@ -54,61 +55,6 @@ subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
integer, intent(out) :: info
character, intent(in), optional :: upd
interface psb_diagsc_bld
subroutine psb_zdiagsc_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_zdiagsc_bld
end interface
interface psb_ilu_bld
subroutine psb_zilu_bld(a,desc_data,p,upd,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
integer, intent(out) :: info
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(inout) :: p
character, intent(in) :: upd
end subroutine psb_zilu_bld
end interface
interface psb_slu_bld
subroutine psb_zslu_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_zspmat_type), intent(inout) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_zslu_bld
end interface
interface psb_umf_bld
subroutine psb_zumf_bld(a,desc_a,p,info)
use psb_serial_mod
use psb_descriptor_type
use psb_prec_type
use psb_const_mod
implicit none
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_zbaseprc_type), intent(inout) :: p
integer, intent(out) :: info
end subroutine psb_zumf_bld
end interface
! Local scalars
Integer :: err, nnzero, n_row, n_col,I,j,k,ictxt,&
src/prec/psb_zilu_bld.f90
+6 -47
View File
@@ -60,6 +60,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
use psb_error_mod
use psb_realloc_mod
use psb_penv_mod
use psb_prec_mod
implicit none
!
! .. Scalar Arguments ..
@@ -83,48 +84,6 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
integer :: ictxt,np,me
character(len=20) :: name, ch_err
interface psb_ilu_fct
subroutine psb_zilu_fct(a,l,u,d,info,blck)
use psb_spmat_type
integer, intent(out) :: info
type(psb_zspmat_type),intent(in) :: a
type(psb_zspmat_type),intent(inout) :: l,u
type(psb_zspmat_type),intent(in), optional, target :: blck
complex(kind(1.d0)), intent(inout) :: d(:)
end subroutine psb_zilu_fct
end interface
interface psb_asmatbld
Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_zasmatbld
end interface
interface psb_sp_renum
subroutine psb_zsp_renum(a,desc_a,blck,p,atmp,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
implicit none
! .. array Arguments ..
type(psb_zspmat_type), intent(in) :: a,blck
type(psb_zspmat_type), intent(inout) :: atmp
type(psb_zbaseprc_type), intent(inout) :: p
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
end subroutine psb_zsp_renum
end interface
if(psb_get_errstatus().ne.0) return
info=0
@@ -157,18 +116,18 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
t1= mpi_wtime()
if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if(debug) write(0,*)me,': calling psb_as_matbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_)
if (debug) call psb_barrier(ictxt)
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
call psb_as_matbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info)
if(info/=0) then
info=4010
ch_err='psb_asmatbld'
ch_err='psb_as_matbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
t2= mpi_wtime()
if (debug) write(0,*)me,': out of psb_asmatbld'
if (debug) write(0,*)me,': out of psb_as_matbld'
if (debug) call psb_barrier(ictxt)
if (allocated(p%av)) then
@@ -219,7 +178,7 @@ subroutine psb_zilu_bld(a,desc_a,p,upd,info)
if (debug) then
write(0,*) me,'Done psb_asmatbld'
write(0,*) me,'Done psb_as_matbld'
call psb_barrier(ictxt)
endif
src/prec/psb_zmlprc_aply.f90
+1 -14
View File
@@ -91,6 +91,7 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod, only : psb_baseprc_aply
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -118,20 +119,6 @@ subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
end type psb_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
interface psb_baseprc_aply
subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: prec
complex(kind(1.d0)),intent(inout) :: x(:), y(:)
complex(kind(1.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
complex(kind(1.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zbaseprc_aply
end interface
name='psb_mlprc_aply'
info = 0
call psb_erractionsave(err_act)
src/prec/psb_zmlprc_bld.f90
+1 -40
View File
@@ -43,6 +43,7 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_zspmat_type), intent(in), target :: a
@@ -57,46 +58,6 @@ subroutine psb_zmlprc_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
type(psb_zspmat_type) :: ac
interface psb_baseprc_bld
subroutine psb_zbaseprc_bld(a,desc_a,p,info,upd)
Use psb_spmat_type
use psb_descriptor_type
use psb_prec_type
type(psb_zspmat_type), target :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_zbaseprc_type),intent(inout) :: p
integer, intent(out) :: info
character, intent(in), optional :: upd
end subroutine psb_zbaseprc_bld
end interface
interface psb_genaggrmap
subroutine psb_zgenaggrmap(aggr_type,a,desc_a,nlaggr,ilaggr,info)
use psb_spmat_type
use psb_descriptor_type
implicit none
integer, intent(in) :: aggr_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, allocatable :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info
end subroutine psb_zgenaggrmap
end interface
interface psb_bldaggrmat
subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info)
use psb_prec_type
use psb_descriptor_type
use psb_spmat_type
type(psb_zspmat_type), intent(in), target :: a
type(psb_zbaseprc_type), intent(inout),target :: p
type(psb_zspmat_type), intent(out),target :: ac
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_ac
integer, intent(out) :: info
end subroutine psb_zbldaggrmat
end interface
integer :: ictxt, np, me
name='psb_mlprec_bld'
src/prec/psb_zprc_aply.f90
+3 -44
View File
@@ -43,6 +43,7 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -60,34 +61,6 @@ subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
external mpi_wtime
character(len=20) :: name
interface psb_baseprc_aply
subroutine psb_zbaseprc_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: prec
complex(kind(0.d0)),intent(inout) :: x(:), y(:)
complex(kind(0.d0)),intent(in) :: alpha,beta
character(len=1) :: trans
complex(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zbaseprc_aply
end interface
interface psb_mlprc_aply
subroutine psb_zmlprc_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_descriptor_type
use psb_prec_type
type(psb_desc_type),intent(in) :: desc_data
type(psb_zbaseprc_type), intent(in) :: baseprecv(:)
complex(kind(0.d0)),intent(in) :: alpha,beta
complex(kind(0.d0)),intent(inout) :: x(:), y(:)
character :: trans
complex(kind(0.d0)),target :: work(:)
integer, intent(out) :: info
end subroutine psb_zmlprc_aply
end interface
name='psb_zprc_aply'
info = 0
call psb_erractionsave(err_act)
@@ -193,6 +166,7 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_desc_type),intent(in) :: desc_data
@@ -202,21 +176,6 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
character(len=1), optional :: trans
logical,parameter :: debug=.false., debugprt=.false.
interface
subroutine psb_zprc_aply(prec,x,y,desc_data,info,trans, work)
use psb_descriptor_type
use psb_prec_type
implicit none
type(psb_desc_type),intent(in) :: desc_data
type(psb_zprec_type), intent(in) :: prec
complex(kind(0.d0)),intent(inout) :: x(:), y(:)
integer, intent(out) :: info
character(len=1), optional :: trans
complex(kind(0.d0)), optional, target :: work(:)
end subroutine psb_zprc_aply
end interface
! Local variables
character :: trans_
@@ -242,7 +201,7 @@ subroutine psb_zprc_aply1(prec,x,desc_data,info,trans)
goto 9999
end if
if (debug) write(0,*) 'Prc_aply1 Size(x) ',size(x), size(ww),size(w1)
call psb_zprc_aply(prec,x,ww,desc_data,info,trans_,work=w1)
call psb_prc_aply(prec,x,ww,desc_data,info,trans_,work=w1)
if(info /=0) goto 9999
x(:) = ww(:)
deallocate(ww,W1)
src/prec/psb_zslu_bld.f90
+4 -19
View File
@@ -41,6 +41,7 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
use psb_tools_mod
use psb_const_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_zspmat_type), intent(inout) :: a
@@ -56,22 +57,6 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_asmatbld
Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_zasmatbld
end interface
if(psb_get_errstatus().ne.0) return
info=0
name='psb_slu_bld'
@@ -103,18 +88,18 @@ subroutine psb_zslu_bld(a,desc_a,p,info)
write(0,*) me, 'SPLUBLD: Done csdp',info,nza,atmp%m,atmp%k
call psb_barrier(ictxt)
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
call psb_as_matbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
if(info /= 0) then
info=4010
ch_err='psb_asmatbld'
ch_err='psb_as_matbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzb = blck%infoa(psb_nnz_)
if (Debug) then
write(0,*) me, 'SPLUBLD: Done asmatbld',info,nzb,blck%fida
write(0,*) me, 'SPLUBLD: Done as_matbld',info,nzb,blck%fida
call psb_barrier(ictxt)
endif
if (nzb > 0 ) then
src/prec/psb_zumf_bld.f90
+4 -19
View File
@@ -41,6 +41,7 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
use psb_tools_mod
use psb_const_mod
use psb_penv_mod
use psb_prec_mod
implicit none
type(psb_zspmat_type), intent(inout) :: a
@@ -57,22 +58,6 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_asmatbld
Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
use psb_serial_mod
Use psb_descriptor_type
Use psb_prec_type
integer, intent(in) :: ptype,novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_zspmat_type), Intent(inout) :: blk
Type(psb_desc_type), Intent(inout) :: desc_p
Type(psb_desc_type), Intent(in) :: desc_data
Character, Intent(in) :: upd
integer, intent(out) :: info
character(len=5), optional :: outfmt
end Subroutine psb_zasmatbld
end interface
info=0
name='psb_umf_bld'
call psb_erractionsave(err_act)
@@ -103,18 +88,18 @@ subroutine psb_zumf_bld(a,desc_a,p,info)
write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k,nzb
call psb_barrier(ictxt)
endif
call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
call psb_as_matbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,&
& blck,desc_a,upd,p%desc_data,info,outfmt=fmt)
if(info /= 0) then
info=4010
ch_err='psb_asmatbld'
ch_err='psb_as_matbld'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzb = psb_sp_get_nnzeros(blck)
if (Debug) then
write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida
write(0,*) me, 'UMFBLD: Done as_matbld',info,nzb,blck%fida
call psb_barrier(ictxt)
endif
if (nzb > 0 ) then
src/serial/psb_dcsdp.f90
+2 -8
View File
@@ -48,6 +48,8 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_error_mod
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, only : psb_cest
implicit none
!....Parameters...
@@ -70,14 +72,6 @@ subroutine psb_dcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
character, intent(inout) :: afmt*5
end subroutine psb_cest
end interface
name='psb_csdp'
info = 0
call psb_erractionsave(err_act)
src/serial/psb_dnumbmm.f90
+2 -14
View File
@@ -40,27 +40,15 @@
!
subroutine psb_dnumbmm(a,b,c)
use psb_realloc_mod
use psb_spmat_type
use psb_serial_mod, only : psb_sp_getrow
implicit none
type(psb_dspmat_type) :: a,b,c
real(kind(1.d0)), allocatable :: temp(:)
integer :: info
interface psb_sp_getrow
subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
real(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgetrow
end interface
allocate(temp(max(a%m,a%k,b%m,b%k)),stat=info)
if (info /= 0) then
src/serial/psb_dspgetrow.f90
+4 -19
View File
@@ -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, only: psb_sp_getblk
implicit none
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
src/serial/psb_dspgtdiag.f90
+3 -15
View File
@@ -45,25 +45,13 @@ subroutine psb_dspgtdiag(a,d,info)
use psb_spmat_type
use psb_error_mod
use psb_const_mod
use psb_serial_mod, only : psb_sp_getblk
implicit none
type(psb_dspmat_type), intent(in) :: a
real(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
interface psb_spgtblk
subroutine psb_dspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_dspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgtblk
end interface
type(psb_dspmat_type) :: tmpa
integer :: i,j,k,nr, nz, err_act, ii, rng, irb, nrb
character(len=20) :: name, ch_err
@@ -102,10 +90,10 @@ subroutine psb_dspgtdiag(a,d,info)
write(0,*)'in spgtdiag'
do i=1, rng, nrb
irb=min(i+nrb-1,rng)
call psb_spgtblk(i,a,tmpa,info,lrw=irb)
call psb_sp_getblk(i,a,tmpa,info,lrw=irb)
if(info.ne.0) then
info=4010
ch_err='psb_spgtblk'
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
src/serial/psb_dsymbmm.f90
+2 -13
View File
@@ -41,6 +41,7 @@
subroutine psb_dsymbmm(a,b,c,info)
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, only : psb_sp_getrow
implicit none
type(psb_dspmat_type) :: a,b,c
@@ -55,19 +56,6 @@ subroutine psb_dsymbmm(a,b,c,info)
integer, allocatable :: ic(:),jc(:)
end subroutine symbmm
end interface
interface psb_sp_getrow
subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_dspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
real(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_dspgetrow
end interface
character(len=20) :: name, ch_err
integer :: err_act
@@ -100,6 +88,7 @@ subroutine psb_dsymbmm(a,b,c,info)
endif
nze = max(a%m+1,2*a%m)
call psb_sp_reall(c,nze,info)
!
! Note: we need to test whether there is a performance impact
! in not using the original Douglas & Bank code.
src/serial/psb_zcsdp.f90
+2 -8
View File
@@ -48,6 +48,8 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
use psb_error_mod
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, only : psb_cest
implicit none
!....Parameters...
@@ -70,14 +72,6 @@ subroutine psb_zcsdp(a, b,info,ifc,check,trans,unitd,upd,dupl)
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
interface psb_cest
subroutine psb_cest(afmt, m,n,nnz, lia1, lia2, lar, iup, info)
integer, intent(in) :: m,n,nnz,iup
integer, intent(out) :: lia1, lia2, lar, info
character, intent(inout) :: afmt*5
end subroutine psb_cest
end interface
name='psb_csdp'
info = 0
call psb_erractionsave(err_act)
src/serial/psb_znumbmm.f90
+2 -14
View File
@@ -40,27 +40,15 @@
!
subroutine psb_znumbmm(a,b,c)
use psb_realloc_mod
use psb_spmat_type
use psb_serial_mod, only : psb_sp_getrow
implicit none
type(psb_zspmat_type) :: a,b,c
complex(kind(1.d0)), allocatable :: temp(:)
integer :: info
interface psb_sp_getrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
complex(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgetrow
end interface
allocate(temp(max(a%m,a%k,b%m,b%k)),stat=info)
if (info /= 0) then
src/serial/psb_zspgetrow.f90
+4 -19
View File
@@ -42,6 +42,8 @@
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, only: psb_sp_getblk
implicit none
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
@@ -50,23 +52,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 +78,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
src/serial/psb_zspgtdiag.f90
+3 -15
View File
@@ -45,25 +45,13 @@ subroutine psb_zspgtdiag(a,d,info)
use psb_spmat_type
use psb_error_mod
use psb_const_mod
use psb_serial_mod, only : psb_sp_getblk
implicit none
type(psb_zspmat_type), intent(in) :: a
complex(kind(1.d0)), intent(inout) :: d(:)
integer, intent(out) :: info
interface psb_spgtblk
subroutine psb_zspgtblk(irw,a,b,info,append,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
type(psb_zspmat_type), intent(inout) :: b
logical, intent(in), optional :: append
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgtblk
end interface
type(psb_zspmat_type) :: tmpa
integer :: i,j,k,nr, nz, err_act, ii, rng, irb, nrb
character(len=20) :: name, ch_err
@@ -102,10 +90,10 @@ subroutine psb_zspgtdiag(a,d,info)
write(0,*)'in spgtdiag'
do i=1, rng, nrb
irb=min(i+nrb-1,rng)
call psb_spgtblk(i,a,tmpa,info,lrw=irb)
call psb_sp_getblk(i,a,tmpa,info,lrw=irb)
if(info.ne.0) then
info=4010
ch_err='psb_spgtblk'
ch_err='psb_sp_getblk'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
src/serial/psb_zsymbmm.f90
+2 -13
View File
@@ -41,6 +41,7 @@
subroutine psb_zsymbmm(a,b,c,info)
use psb_spmat_type
use psb_string_mod
use psb_serial_mod, only : psb_sp_getrow
implicit none
type(psb_zspmat_type) :: a,b,c
@@ -56,19 +57,6 @@ subroutine psb_zsymbmm(a,b,c,info)
end subroutine symbmm
end interface
interface psb_sp_getrow
subroutine psb_zspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw)
use psb_spmat_type
type(psb_zspmat_type), intent(in) :: a
integer, intent(in) :: irw
integer, intent(out) :: nz
integer, intent(inout) :: ia(:), ja(:)
complex(kind(1.d0)), intent(inout) :: val(:)
integer, intent(in), target, optional :: iren(:)
integer, intent(in), optional :: lrw
integer, intent(out) :: info
end subroutine psb_zspgetrow
end interface
character(len=20) :: name, ch_err
integer :: err_act
name='psb_symbmm'
@@ -113,6 +101,7 @@ subroutine psb_zsymbmm(a,b,c,info)
call inner_symbmm(a,b,c,itemp,info)
endif
call psb_realloc(size(c%ia1),c%aspk,info)
c%pl(1) = 0
c%pr(1) = 0
c%m=a%m
src/tools/psb_cdren.f90
+1 -18
View File
@@ -45,15 +45,9 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
use psb_error_mod
use psb_penv_mod
use psb_string_mod
use psb_serial_mod
implicit none
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
!...parameters....
type(psb_desc_type), intent(inout) :: desc_a
integer, intent(inout) :: iperm(:)
@@ -63,8 +57,6 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
integer :: i,j,np,me, n_col, kh, nh
integer :: dectype
integer :: ictxt,n_row, int_err(5), err_act
real(kind(1.d0)) :: time(10), mpi_wtime, real_err(6)
external mpi_wtime
logical, parameter :: debug=.false.
character(len=20) :: name
@@ -73,8 +65,6 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
call psb_erractionsave(err_act)
name = 'psb_dcren'
time(1) = mpi_wtime()
ictxt = psb_cd_get_context(desc_a)
dectype = psb_cd_get_dectype(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
@@ -207,13 +197,6 @@ subroutine psb_cdren(trans,iperm,desc_a,info)
endif
time(4) = mpi_wtime()
time(4) = time(4) - time(3)
if (debug) then
call psb_amx(ictxt, time(4))
write (*, *) ' comm structs assembly: ', time(4)*1.d-3
end if
call psb_erractionrestore(err_act)
return
src/tools/psb_dcsrp.f90
+1 -34
View File
@@ -47,28 +47,6 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
use psb_penv_mod
! implicit none
interface dcsrp
subroutine dcsrp(trans,m,n,fida,descra,ia1,ia2,&
& infoa,p,work,lwork,ierror)
integer, intent(in) :: m, n, lwork
integer, intent(out) :: ierror
character, intent(in) :: trans
double precision, intent(inout) :: work(*)
integer, intent(in) :: p(*)
integer, intent(inout) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine dcsrp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
!...parameters....
type(psb_dspmat_type), intent(inout) :: a
@@ -83,12 +61,8 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
integer :: ictxt,n_row,err_act, int_err(5)
character(len=20) :: name, char_err
real(kind(1.d0)) :: time(10), mpi_wtime
external mpi_wtime
logical, parameter :: debug=.false.
time(1) = mpi_wtime()
ictxt = psb_cd_get_context(desc_a)
dectype = psb_cd_get_dectype(desc_a)
n_row = psb_cd_get_local_rows(desc_a)
@@ -159,7 +133,7 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
! hmm, maybe we should just move all of this onto a different level,
! have a specialized subroutine, and do it in the solver context????
if (debug) write(0,*) 'spasb: calling dcsrp',size(work_dcsdp)
call dcsrp(trans,n_row,n_col,a%fida,a%descra,a%ia1,a%ia2,a%infoa,&
call csrp(trans,n_row,n_col,a%fida,a%descra,a%ia1,a%ia2,a%infoa,&
& ipt,work_dcsdp,size(work_dcsdp),info)
if(info /= no_err) then
info=4010
@@ -170,13 +144,6 @@ subroutine psb_dcsrp(trans,iperm,a, desc_a, info)
deallocate(ipt,work_dcsdp)
time(4) = mpi_wtime()
time(4) = time(4) - time(3)
if (debug) then
call psb_amx(ictxt, time(4))
write (*, *) ' comm structs assembly: ', time(4)*1.d-3
end if
call psb_erractionrestore(err_act)
return
src/tools/psb_dgelp.f90
-17
View File
@@ -69,15 +69,6 @@ subroutine psb_dgelp(trans,iperm,x,desc_a,info)
integer, intent(in) :: p(*)
end subroutine dgelp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
character(len=20) :: name, ch_err
name = 'psb_dgelp'
@@ -214,14 +205,6 @@ subroutine psb_dgelpv(trans,iperm,x,desc_a,info)
end subroutine dgelp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
character(len=20) :: name, ch_err
name = 'psb_dgelpv'
src/tools/psb_dins.f90
-10
View File
@@ -73,11 +73,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act)
name = 'psb_dinsvi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
@@ -257,11 +252,6 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act)
name = 'psb_dinsi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
src/tools/psb_dspcnv.f90
+6 -90
View File
@@ -49,49 +49,6 @@ subroutine psb_dspcnv(a,b,desc_a,info)
use psb_error_mod
use psb_penv_mod
implicit none
interface dcsdp
subroutine dcsdp(check,trans,m,n,unitd,d,&
& fida,descra,a,ia1,ia2,infoa,&
& pl,fidh,descrh,h,ih1,ih2,infoh,pr,lh,lh1,lh2,&
& work,lwork,ierror)
integer, intent(in) :: lh, lwork, lh1, lh2, m, n
integer, intent(out) :: ierror
character, intent(in) :: check, trans, unitd
real(kind(1.d0)), intent(in) :: d(*), a(*)
real(kind(1.d0)), intent(out) :: h(*)
real(kind(1.d0)), intent(inout) :: work(*)
integer, intent(in) :: ia1(*), ia2(*), infoa(*)
integer, intent(out) :: ih1(*), ih2(*), pl(*),pr(*), infoh(*)
character, intent(in) :: fida*5, descra*11
character, intent(out) :: fidh*5, descrh*11
end subroutine dcsdp
end interface
interface dcsrp
subroutine dcsrp(trans,m,n,fida,descra,ia1,ia2,&
& infoa,p,work,lwork,ierror)
integer, intent(in) :: m, n, lwork
integer, intent(out) :: ierror
character, intent(in) :: trans
real(kind(1.d0)), intent(inout) :: work(*)
integer, intent(in) :: p(*)
integer, intent(inout) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine dcsrp
end interface
interface dcsprt
subroutine dcsprt(m,n,fida,descra,a,ia1,ia2,infoa ,iout,ierror)
integer, intent(in) :: iout,m, n
integer, intent(out) :: ierror
real(kind(1.d0)), intent(in) :: a(*)
integer, intent(in) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine dcsprt
end interface
!...parameters....
type(psb_dspmat_type), intent(in) :: a
@@ -100,17 +57,11 @@ subroutine psb_dspcnv(a,b,desc_a,info)
integer, intent(out) :: info
!....locals....
integer :: int_err(5)
real(kind(1.d0)) :: d(1)
integer,allocatable :: i_temp(:)
real(kind(1.d0)),allocatable :: work_dcsdp(:)
integer :: ia1_size,ia2_size,aspk_size,&
& err_act,i,np,me,n_col,l_dcsdp
integer :: lwork_dcsdp,dectype
integer :: ia1_size,ia2_size,aspk_size,err_act&
& ,i,err,np,me,n_col
integer, allocatable :: i_temp(:)
integer :: dectype
integer :: ictxt,n_row
character :: check*1, trans*1, unitd*1
real(kind(1.d0)) :: time(10), mpi_wtime
external mpi_wtime
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@@ -119,7 +70,6 @@ subroutine psb_dspcnv(a,b,desc_a,info)
name = 'psb_dspcnv'
call psb_erractionsave(err_act)
time(1) = mpi_wtime()
ictxt = psb_cd_get_context(desc_a)
dectype = psb_cd_get_dectype(desc_a)
@@ -149,46 +99,15 @@ subroutine psb_dspcnv(a,b,desc_a,info)
if (debug) write (0, *) name,' sizes',ia1_size,ia2_size,aspk_size
! convert only without check
check='N'
trans='N'
unitd='U'
! l_dcsdp is the size requested for dcsdp procedure
l_dcsdp=(ia1_size+100)
b%m=n_row
b%k=n_col
call psb_sp_all(b,ia1_size,ia2_size,aspk_size,info)
allocate(work_dcsdp(l_dcsdp),stat=info)
if (info /= 0) then
info=2025
int_err(1)=l_dcsdp
call psb_errpush(info, name, i_err=int_err)
goto 9999
endif
lwork_dcsdp=size(work_dcsdp)
! set infoa(1) to nnzero
b%pl(:) = 0
b%pr(:) = 0
if (debug) write (0, *) name,' calling dcsdp',lwork_dcsdp,&
&size(work_dcsdp)
! convert aspk,ia1,ia2 in requested representation mode
if (debug) then
endif
! result is put in b
call dcsdp(check,trans,n_row,n_col,unitd,d,a%fida,a%descra,&
& a%aspk,a%ia1,a%ia2,a%infoa,&
& b%pl,b%fida,b%descra,b%aspk,b%ia1,b%ia2,b%infoa,b%pr,&
& size(b%aspk),size(b%ia1),size(b%ia2),&
& work_dcsdp,size(work_dcsdp),info)
call psb_csdp(a,b,info)
if(info /= no_err) then
info=4010
ch_err='dcsdp'
ch_err='psb_csdp'
call psb_errpush(info, name, a_err=ch_err)
goto 9999
end if
@@ -228,9 +147,6 @@ subroutine psb_dspcnv(a,b,desc_a,info)
endif
if (debug) write (0, *) me,name,' from dcsdp ',&
&b%fida,' pl ', b%pl(:),'pr',b%pr(:)
call psb_erractionrestore(err_act)
return
src/tools/psb_dspins.f90
+1 -21
View File
@@ -52,6 +52,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_tools_mod
implicit none
!....parameters...
@@ -70,27 +71,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
logical :: rebuild_
integer, allocatable :: ila(:),jla(:)
interface psb_cdins
subroutine psb_cdins(nz,ia,ja,desc_a,info,ila,jla)
use psb_descriptor_type
implicit none
type(psb_desc_type), intent(inout) :: desc_a
integer, intent(in) :: nz,ia(:),ja(:)
integer, intent(out) :: info
integer, optional, intent(out) :: ila(:), jla(:)
end subroutine psb_cdins
end interface
interface psb_glob_to_loc
subroutine psb_glob_to_loc(x,desc_a,info,iact)
use psb_descriptor_type
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: x(:)
integer, intent(out) :: info
character, intent(in), optional :: iact
end subroutine psb_glob_to_loc
end interface
character(len=20) :: name, ch_err
info = 0
src/tools/psb_iins.f90
-10
View File
@@ -73,11 +73,6 @@ subroutine psb_iinsvi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act)
name = 'psb_insvi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
@@ -256,11 +251,6 @@ subroutine psb_iinsi(m,irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act)
name = 'psb_iinsi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
src/tools/psb_zcsrp.f90
+3 -23
View File
@@ -45,29 +45,9 @@ subroutine psb_zcsrp(trans,iperm,a, desc_a, info)
use psb_serial_mod
use psb_const_mod
use psb_penv_mod
! implicit none
use psb_serial_mod
implicit none
interface
subroutine zcsrp(trans,m,n,fida,descra,ia1,ia2,&
& infoa,p,work,lwork,ierror)
integer, intent(in) :: m, n, lwork
integer, intent(out) :: ierror
character, intent(in) :: trans
complex(kind(1.d0)), intent(inout) :: work(*)
integer, intent(in) :: p(*)
integer, intent(inout) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine zcsrp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
!...parameters....
type(psb_zspmat_type), intent(inout) :: a
@@ -158,7 +138,7 @@ subroutine psb_zcsrp(trans,iperm,a, desc_a, info)
! hmm, maybe we should just move all of this onto a different level,
! have a specialized subroutine, and do it in the solver context????
if (debug) write(0,*) 'spasb: calling dcsrp',size(work_dcsdp)
call zcsrp(trans,n_row,n_col,a%fida,a%descra,a%ia1,a%ia2,a%infoa,&
call csrp(trans,n_row,n_col,a%fida,a%descra,a%ia1,a%ia2,a%infoa,&
& ipt,work_dcsdp,size(work_dcsdp),info)
if(info /= no_err) then
info=4010
src/tools/psb_zgelp.f90
+1 -17
View File
@@ -71,14 +71,6 @@ subroutine psb_zgelp(trans,iperm,x,desc_a,info)
end subroutine zgelp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
character(len=20) :: name, ch_err
name = 'psb_zgelp'
@@ -213,16 +205,8 @@ subroutine psb_zgelpv(trans,iperm,x,desc_a,info)
integer, intent(in) :: p(*)
end subroutine zgelp
end interface
interface isaperm
logical function isaperm(n,ip)
integer, intent(in) :: n
integer, intent(inout) :: ip(*)
end function isaperm
end interface
character(len=20) :: name, ch_err
name = 'psb_zgelpv'
if(psb_get_errstatus() /= 0) return
src/tools/psb_zins.f90
-10
View File
@@ -74,11 +74,6 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act)
name = 'psb_zinsvi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
@@ -257,11 +252,6 @@ subroutine psb_zinsi(m,irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act)
name = 'psb_zinsi'
!!$ if (.not.allocated(desc_a%glob_to_loc)) then
!!$ info=3110
!!$ call psb_errpush(info,name)
!!$ return
!!$ end if
if ((.not.allocated(desc_a%matrix_data))) then
int_err(1)=3110
call psb_errpush(info,name)
src/tools/psb_zspcnv.f90
+46 -130
View File
@@ -1,44 +1,44 @@
!!$
!!$ 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_zspcnv.f90
!
! Subroutine: psb_zspcnv
! converts sparse matrix a into b
!
! Parameters:
! a - type(<psb_zspmat_type>). The sparse input matrix.
! b - type(<psb_zspmat_type>). The sparse output matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code.
!
!!$
!!$ 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_zspcnv.f90
!
! Subroutine: psb_zspcnv
! converts sparse matrix a into b
!
! Parameters:
! a - type(<psb_zspmat_type>). The sparse input matrix.
! b - type(<psb_zspmat_type>). The sparse output matrix.
! desc_a - type(<psb_desc_type>). The communication descriptor.
! info - integer. Eventually returns an error code.
!
subroutine psb_zspcnv(a,b,desc_a,info)
use psb_descriptor_type
@@ -50,49 +50,6 @@ subroutine psb_zspcnv(a,b,desc_a,info)
use psb_penv_mod
implicit none
interface zcsdp
subroutine zcsdp(check,trans,m,n,unitd,d,&
& fida,descra,a,ia1,ia2,infoa,&
& pl,fidh,descrh,h,ih1,ih2,infoh,pr,lh,lh1,lh2,&
& work,lwork,ierror)
integer, intent(in) :: lh, lwork, lh1, lh2, m, n
integer, intent(out) :: ierror
character, intent(in) :: check, trans, unitd
complex(kind(1.d0)), intent(in) :: d(*), a(*)
complex(kind(1.d0)), intent(out) :: h(*)
complex(kind(1.d0)), intent(inout) :: work(*)
integer, intent(in) :: ia1(*), ia2(*), infoa(*)
integer, intent(out) :: ih1(*), ih2(*), pl(*),pr(*), infoh(*)
character, intent(in) :: fida*5, descra*11
character, intent(out) :: fidh*5, descrh*11
end subroutine zcsdp
end interface
interface zcsrp
subroutine zcsrp(trans,m,n,fida,descra,ia1,ia2,&
& infoa,p,work,lwork,ierror)
integer, intent(in) :: m, n, lwork
integer, intent(out) :: ierror
character, intent(in) :: trans
complex(kind(1.d0)), intent(inout) :: work(*)
integer, intent(in) :: p(*)
integer, intent(inout) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine zcsrp
end interface
interface zcsprt
subroutine zcsprt(m,n,fida,descra,a,ia1,ia2,infoa ,iout,ierror)
integer, intent(in) :: iout,m, n
integer, intent(out) :: ierror
complex(kind(1.d0)), intent(in) :: a(*)
integer, intent(in) :: ia1(*), ia2(*), infoa(*)
character, intent(in) :: fida*5, descra*11
end subroutine zcsprt
end interface
!...parameters....
type(psb_zspmat_type), intent(in) :: a
@@ -101,17 +58,11 @@ subroutine psb_zspcnv(a,b,desc_a,info)
integer, intent(out) :: info
!....locals....
integer :: int_err(5)
complex(kind(1.d0)) :: d(1)
integer,allocatable :: i_temp(:)
complex(kind(1.d0)),allocatable :: work_dcsdp(:)
integer :: ia1_size,ia2_size,aspk_size,err_act&
& ,i,err,np,me,n_col,l_dcsdp
integer :: lwork_dcsdp,dectype
& ,i,err,np,me,n_col
integer, allocatable :: i_temp(:)
integer :: dectype
integer :: ictxt,n_row
character :: check*1, trans*1, unitd*1
real(kind(1.d0)) :: time(10), mpi_wtime
external mpi_wtime
logical, parameter :: debug=.false.
character(len=20) :: name, ch_err
@@ -120,7 +71,6 @@ subroutine psb_zspcnv(a,b,desc_a,info)
name = 'psb_zspcnv'
call psb_erractionsave(err_act)
time(1) = mpi_wtime()
ictxt = psb_cd_get_context(desc_a)
dectype = psb_cd_get_dectype(desc_a)
@@ -150,46 +100,15 @@ subroutine psb_zspcnv(a,b,desc_a,info)
if (debug) write (0, *) name,' sizes',ia1_size,ia2_size,aspk_size
! convert only without check
check='N'
trans='N'
unitd='U'
! l_dcsdp is the size requested for dcsdp procedure
l_dcsdp=(ia1_size+100)
b%m=n_row
b%k=n_col
call psb_sp_all(b,ia1_size,ia2_size,aspk_size,info)
allocate(work_dcsdp(l_dcsdp),stat=info)
if (info /= 0) then
info=2025
int_err(1)=l_dcsdp
call psb_errpush(info, name, i_err=int_err)
goto 9999
endif
lwork_dcsdp=size(work_dcsdp)
! set infoa(1) to nnzero
b%pl(:) = 0
b%pr(:) = 0
if (debug) write (0, *) name,' calling dcsdp',lwork_dcsdp,&
&size(work_dcsdp)
! convert aspk,ia1,ia2 in requested representation mode
if (debug) then
endif
! result is put in b
call zcsdp(check,trans,n_row,n_col,unitd,d,a%fida,a%descra,&
& a%aspk,a%ia1,a%ia2,a%infoa,&
& b%pl,b%fida,b%descra,b%aspk,b%ia1,b%ia2,b%infoa,b%pr,&
& size(b%aspk),size(b%ia1),size(b%ia2),&
& work_dcsdp,size(work_dcsdp),info)
call psb_csdp(a,b,info)
if(info /= no_err) then
info=4010
ch_err='zcsdp'
ch_err='psb_csdp'
call psb_errpush(info, name, a_err=ch_err)
goto 9999
end if
@@ -229,9 +148,6 @@ subroutine psb_zspcnv(a,b,desc_a,info)
endif
if (debug) write (0, *) me,name,' from zcsdp ',&
&b%fida,' pl ', b%pl(:),'pr',b%pr(:)
call psb_erractionrestore(err_act)
return
src/tools/psb_zspins.f90
-21
View File
@@ -71,27 +71,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
logical :: rebuild_
integer, allocatable :: ila(:),jla(:)
!!$ interface psb_cdins
!!$ subroutine psb_cdins(nz,ia,ja,desc_a,info,ila,jla)
!!$ use psb_descriptor_type
!!$ implicit none
!!$ type(psb_desc_type), intent(inout) :: desc_a
!!$ integer, intent(in) :: nz,ia(:),ja(:)
!!$ integer, intent(out) :: info
!!$ integer, optional, intent(out) :: ila(:), jla(:)
!!$ end subroutine psb_cdins
!!$ end interface
!!$
!!$ interface psb_glob_to_loc
!!$ subroutine psb_glob_to_loc(x,desc_a,info,iact)
!!$ use psb_descriptor_type
!!$ implicit none
!!$ type(psb_desc_type), intent(in) :: desc_a
!!$ integer, intent(inout) :: x(:)
!!$ integer, intent(out) :: info
!!$ character, intent(in), optional :: iact
!!$ end subroutine psb_glob_to_loc
!!$ end interface
character(len=20) :: name, ch_err
info = 0