From 05721fa5fdf978e515598d71bf6cfbdf28d277f5 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 5 Dec 2006 12:07:42 +0000 Subject: [PATCH] Fixed interface use, insert use statements wherever possible. --- Changelog | 3 + src/internals/psi_crea_index.f90 | 28 +- src/modules/psb_prec_mod.f90 | 305 ++++++++++++++ src/modules/psb_serial_mod.f90 | 683 ++++++++++++++++--------------- src/modules/psi_mod.f90 | 25 +- src/prec/psb_dbaseprc_aply.f90 | 14 +- src/prec/psb_dbaseprc_bld.f90 | 57 +-- src/prec/psb_dilu_bld.f90 | 54 +-- src/prec/psb_dmlprc_aply.f90 | 15 +- src/prec/psb_dmlprc_bld.f90 | 40 +- src/prec/psb_dprc_aply.f90 | 47 +-- src/prec/psb_dslu_bld.f90 | 23 +- src/prec/psb_dumf_bld.f90 | 23 +- src/prec/psb_zbaseprc_aply.f90 | 15 +- src/prec/psb_zbaseprc_bld.f90 | 56 +-- src/prec/psb_zilu_bld.f90 | 53 +-- src/prec/psb_zmlprc_aply.f90 | 15 +- src/prec/psb_zmlprc_bld.f90 | 41 +- src/prec/psb_zprc_aply.f90 | 47 +-- src/prec/psb_zslu_bld.f90 | 23 +- src/prec/psb_zumf_bld.f90 | 23 +- src/serial/psb_dcsdp.f90 | 10 +- src/serial/psb_dnumbmm.f90 | 16 +- src/serial/psb_dspgetrow.f90 | 23 +- src/serial/psb_dspgtdiag.f90 | 18 +- src/serial/psb_dsymbmm.f90 | 15 +- src/serial/psb_zcsdp.f90 | 10 +- src/serial/psb_znumbmm.f90 | 16 +- src/serial/psb_zspgetrow.f90 | 23 +- src/serial/psb_zspgtdiag.f90 | 18 +- src/serial/psb_zsymbmm.f90 | 15 +- src/tools/psb_cdren.f90 | 19 +- src/tools/psb_dcsrp.f90 | 35 +- src/tools/psb_dgelp.f90 | 17 - src/tools/psb_dins.f90 | 10 - src/tools/psb_dspcnv.f90 | 96 +---- src/tools/psb_dspins.f90 | 22 +- src/tools/psb_iins.f90 | 10 - src/tools/psb_zcsrp.f90 | 28 +- src/tools/psb_zgelp.f90 | 18 +- src/tools/psb_zins.f90 | 10 - src/tools/psb_zspcnv.f90 | 176 +++----- src/tools/psb_zspins.f90 | 21 - 43 files changed, 815 insertions(+), 1401 deletions(-) diff --git a/Changelog b/Changelog index 76e098c9..f949f499 100644 --- a/Changelog +++ b/Changelog @@ -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 diff --git a/src/internals/psi_crea_index.f90 b/src/internals/psi_crea_index.f90 index 388492d0..98e4462d 100644 --- a/src/internals/psi_crea_index.f90 +++ b/src/internals/psi_crea_index.f90 @@ -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) diff --git a/src/modules/psb_prec_mod.f90 b/src/modules/psb_prec_mod.f90 index 17f25d6b..f40a5f7e 100644 --- a/src/modules/psb_prec_mod.f90 +++ b/src/modules/psb_prec_mod.f90 @@ -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 diff --git a/src/modules/psb_serial_mod.f90 b/src/modules/psb_serial_mod.f90 index 6218e35d..0f674536 100644 --- a/src/modules/psb_serial_mod.f90 +++ b/src/modules/psb_serial_mod.f90 @@ -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 diff --git a/src/modules/psi_mod.f90 b/src/modules/psi_mod.f90 index fd500f0a..c683a579 100644 --- a/src/modules/psi_mod.f90 +++ b/src/modules/psi_mod.f90 @@ -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 diff --git a/src/prec/psb_dbaseprc_aply.f90 b/src/prec/psb_dbaseprc_aply.f90 index 91d72e23..a709166c 100644 --- a/src/prec/psb_dbaseprc_aply.f90 +++ b/src/prec/psb_dbaseprc_aply.f90 @@ -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 diff --git a/src/prec/psb_dbaseprc_bld.f90 b/src/prec/psb_dbaseprc_bld.f90 index 34718611..1f29032a 100644 --- a/src/prec/psb_dbaseprc_bld.f90 +++ b/src/prec/psb_dbaseprc_bld.f90 @@ -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,& diff --git a/src/prec/psb_dilu_bld.f90 b/src/prec/psb_dilu_bld.f90 index 822323b9..c01e714c 100644 --- a/src/prec/psb_dilu_bld.f90 +++ b/src/prec/psb_dilu_bld.f90 @@ -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 diff --git a/src/prec/psb_dmlprc_aply.f90 b/src/prec/psb_dmlprc_aply.f90 index 90c0ad18..cb6fd55f 100644 --- a/src/prec/psb_dmlprc_aply.f90 +++ b/src/prec/psb_dmlprc_aply.f90 @@ -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) diff --git a/src/prec/psb_dmlprc_bld.f90 b/src/prec/psb_dmlprc_bld.f90 index d2faaadf..715d43c8 100644 --- a/src/prec/psb_dmlprc_bld.f90 +++ b/src/prec/psb_dmlprc_bld.f90 @@ -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 diff --git a/src/prec/psb_dprc_aply.f90 b/src/prec/psb_dprc_aply.f90 index 588b5ec7..9f972241 100644 --- a/src/prec/psb_dprc_aply.f90 +++ b/src/prec/psb_dprc_aply.f90 @@ -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) diff --git a/src/prec/psb_dslu_bld.f90 b/src/prec/psb_dslu_bld.f90 index b21efdb6..ad09e579 100644 --- a/src/prec/psb_dslu_bld.f90 +++ b/src/prec/psb_dslu_bld.f90 @@ -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 diff --git a/src/prec/psb_dumf_bld.f90 b/src/prec/psb_dumf_bld.f90 index f6e1ad7d..f3426b16 100644 --- a/src/prec/psb_dumf_bld.f90 +++ b/src/prec/psb_dumf_bld.f90 @@ -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 diff --git a/src/prec/psb_zbaseprc_aply.f90 b/src/prec/psb_zbaseprc_aply.f90 index bd70c142..dd588774 100644 --- a/src/prec/psb_zbaseprc_aply.f90 +++ b/src/prec/psb_zbaseprc_aply.f90 @@ -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) diff --git a/src/prec/psb_zbaseprc_bld.f90 b/src/prec/psb_zbaseprc_bld.f90 index cb293791..1d5973d1 100644 --- a/src/prec/psb_zbaseprc_bld.f90 +++ b/src/prec/psb_zbaseprc_bld.f90 @@ -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,& diff --git a/src/prec/psb_zilu_bld.f90 b/src/prec/psb_zilu_bld.f90 index a14e69d2..409cf66e 100644 --- a/src/prec/psb_zilu_bld.f90 +++ b/src/prec/psb_zilu_bld.f90 @@ -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 diff --git a/src/prec/psb_zmlprc_aply.f90 b/src/prec/psb_zmlprc_aply.f90 index 8fb70867..771bc210 100644 --- a/src/prec/psb_zmlprc_aply.f90 +++ b/src/prec/psb_zmlprc_aply.f90 @@ -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) diff --git a/src/prec/psb_zmlprc_bld.f90 b/src/prec/psb_zmlprc_bld.f90 index 05b86faf..b817a72d 100644 --- a/src/prec/psb_zmlprc_bld.f90 +++ b/src/prec/psb_zmlprc_bld.f90 @@ -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' diff --git a/src/prec/psb_zprc_aply.f90 b/src/prec/psb_zprc_aply.f90 index 0b68a765..b07df5c0 100644 --- a/src/prec/psb_zprc_aply.f90 +++ b/src/prec/psb_zprc_aply.f90 @@ -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) diff --git a/src/prec/psb_zslu_bld.f90 b/src/prec/psb_zslu_bld.f90 index 35645d53..66c8defc 100644 --- a/src/prec/psb_zslu_bld.f90 +++ b/src/prec/psb_zslu_bld.f90 @@ -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 diff --git a/src/prec/psb_zumf_bld.f90 b/src/prec/psb_zumf_bld.f90 index f4b6ede3..b54d7f00 100644 --- a/src/prec/psb_zumf_bld.f90 +++ b/src/prec/psb_zumf_bld.f90 @@ -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 diff --git a/src/serial/psb_dcsdp.f90 b/src/serial/psb_dcsdp.f90 index 89d1cf76..306b96fd 100644 --- a/src/serial/psb_dcsdp.f90 +++ b/src/serial/psb_dcsdp.f90 @@ -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) diff --git a/src/serial/psb_dnumbmm.f90 b/src/serial/psb_dnumbmm.f90 index ea04d807..47aea663 100644 --- a/src/serial/psb_dnumbmm.f90 +++ b/src/serial/psb_dnumbmm.f90 @@ -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 diff --git a/src/serial/psb_dspgetrow.f90 b/src/serial/psb_dspgetrow.f90 index ad692bec..b1c73039 100644 --- a/src/serial/psb_dspgetrow.f90 +++ b/src/serial/psb_dspgetrow.f90 @@ -42,6 +42,8 @@ subroutine psb_dspgetrow(irw,a,nz,ia,ja,val,info,iren,lrw) use psb_spmat_type use psb_string_mod + use psb_serial_mod, 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 diff --git a/src/serial/psb_dspgtdiag.f90 b/src/serial/psb_dspgtdiag.f90 index 3e0e354d..78c06f31 100644 --- a/src/serial/psb_dspgtdiag.f90 +++ b/src/serial/psb_dspgtdiag.f90 @@ -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 diff --git a/src/serial/psb_dsymbmm.f90 b/src/serial/psb_dsymbmm.f90 index 81e93c06..5d9628cd 100644 --- a/src/serial/psb_dsymbmm.f90 +++ b/src/serial/psb_dsymbmm.f90 @@ -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. diff --git a/src/serial/psb_zcsdp.f90 b/src/serial/psb_zcsdp.f90 index b558945b..6db5f772 100644 --- a/src/serial/psb_zcsdp.f90 +++ b/src/serial/psb_zcsdp.f90 @@ -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) diff --git a/src/serial/psb_znumbmm.f90 b/src/serial/psb_znumbmm.f90 index 53f4f031..d6756025 100644 --- a/src/serial/psb_znumbmm.f90 +++ b/src/serial/psb_znumbmm.f90 @@ -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 diff --git a/src/serial/psb_zspgetrow.f90 b/src/serial/psb_zspgetrow.f90 index 18e1e2b8..f44dd7b6 100644 --- a/src/serial/psb_zspgetrow.f90 +++ b/src/serial/psb_zspgetrow.f90 @@ -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 diff --git a/src/serial/psb_zspgtdiag.f90 b/src/serial/psb_zspgtdiag.f90 index faead301..1aca7893 100644 --- a/src/serial/psb_zspgtdiag.f90 +++ b/src/serial/psb_zspgtdiag.f90 @@ -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 diff --git a/src/serial/psb_zsymbmm.f90 b/src/serial/psb_zsymbmm.f90 index 8c0fe2f9..6627f30a 100644 --- a/src/serial/psb_zsymbmm.f90 +++ b/src/serial/psb_zsymbmm.f90 @@ -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 diff --git a/src/tools/psb_cdren.f90 b/src/tools/psb_cdren.f90 index cfb0f7a7..54709872 100644 --- a/src/tools/psb_cdren.f90 +++ b/src/tools/psb_cdren.f90 @@ -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 diff --git a/src/tools/psb_dcsrp.f90 b/src/tools/psb_dcsrp.f90 index b0422af4..ce89c9ce 100644 --- a/src/tools/psb_dcsrp.f90 +++ b/src/tools/psb_dcsrp.f90 @@ -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 diff --git a/src/tools/psb_dgelp.f90 b/src/tools/psb_dgelp.f90 index 1dd8d561..6c848aa7 100644 --- a/src/tools/psb_dgelp.f90 +++ b/src/tools/psb_dgelp.f90 @@ -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' diff --git a/src/tools/psb_dins.f90 b/src/tools/psb_dins.f90 index 25c603e0..20f93aa5 100644 --- a/src/tools/psb_dins.f90 +++ b/src/tools/psb_dins.f90 @@ -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) diff --git a/src/tools/psb_dspcnv.f90 b/src/tools/psb_dspcnv.f90 index a8056f88..798df3a3 100644 --- a/src/tools/psb_dspcnv.f90 +++ b/src/tools/psb_dspcnv.f90 @@ -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 diff --git a/src/tools/psb_dspins.f90 b/src/tools/psb_dspins.f90 index 418e1262..b23176f4 100644 --- a/src/tools/psb_dspins.f90 +++ b/src/tools/psb_dspins.f90 @@ -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 diff --git a/src/tools/psb_iins.f90 b/src/tools/psb_iins.f90 index fb6e3a9c..ec8087c9 100644 --- a/src/tools/psb_iins.f90 +++ b/src/tools/psb_iins.f90 @@ -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) diff --git a/src/tools/psb_zcsrp.f90 b/src/tools/psb_zcsrp.f90 index 4c5fab0d..8a0f2aba 100644 --- a/src/tools/psb_zcsrp.f90 +++ b/src/tools/psb_zcsrp.f90 @@ -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 - - 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 + use psb_serial_mod + implicit none + !...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 diff --git a/src/tools/psb_zgelp.f90 b/src/tools/psb_zgelp.f90 index 3613583a..ac83ddcc 100644 --- a/src/tools/psb_zgelp.f90 +++ b/src/tools/psb_zgelp.f90 @@ -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 diff --git a/src/tools/psb_zins.f90 b/src/tools/psb_zins.f90 index 6f7773f7..54981909 100644 --- a/src/tools/psb_zins.f90 +++ b/src/tools/psb_zins.f90 @@ -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) diff --git a/src/tools/psb_zspcnv.f90 b/src/tools/psb_zspcnv.f90 index c3d24568..a2beaf90 100644 --- a/src/tools/psb_zspcnv.f90 +++ b/src/tools/psb_zspcnv.f90 @@ -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(). The sparse input matrix. -! b - type(). The sparse output matrix. -! desc_a - 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(). The sparse input matrix. + ! b - type(). The sparse output matrix. + ! desc_a - 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 diff --git a/src/tools/psb_zspins.f90 b/src/tools/psb_zspins.f90 index 712bb241..6240570e 100644 --- a/src/tools/psb_zspins.f90 +++ b/src/tools/psb_zspins.f90 @@ -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