From 5e7c98a795ffa35783404f858fb9a3d9b9946632 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 30 Sep 2013 16:46:53 +0000 Subject: [PATCH] psblas3: base/modules/psb_cd_tools_mod.f90 base/tools/psb_cdins.f90 base/tools/psb_dspins.f90 Try to avoid multiple redundant checks in spins. --- base/modules/psb_cd_tools_mod.f90 | 6 ++-- base/tools/psb_cdins.f90 | 59 ++++++++++++++++++------------- base/tools/psb_dspins.f90 | 14 ++++---- 3 files changed, 46 insertions(+), 33 deletions(-) diff --git a/base/modules/psb_cd_tools_mod.f90 b/base/modules/psb_cd_tools_mod.f90 index 6595325e..af337fb2 100644 --- a/base/modules/psb_cd_tools_mod.f90 +++ b/base/modules/psb_cd_tools_mod.f90 @@ -91,14 +91,15 @@ module psb_cd_tools_mod end interface interface psb_cdins - subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) + subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla,dontcheck) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc_a integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) + logical, intent(in), optional :: dontcheck end subroutine psb_cdinsrc - subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) + subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc integer(psb_ipk_), intent(in) :: nz,ja(:) @@ -106,6 +107,7 @@ module psb_cd_tools_mod integer(psb_ipk_), optional, intent(out) :: jla(:) logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) + logical, intent(in), optional :: dontcheck end subroutine psb_cdinsc end interface diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.f90 index 0616c6a2..7c4920ef 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.f90 @@ -45,7 +45,7 @@ ! ila(:) - integer(psb_ipk_), optional The row indices in local numbering ! jla(:) - integer(psb_ipk_), optional The col indices in local numbering ! -subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) +subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck) use psb_base_mod, psb_protect_name => psb_cdinsrc use psi_mod implicit none @@ -55,7 +55,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) - + logical, intent(in), optional :: dontcheck !LOCALS..... integer(psb_ipk_) :: ictxt,dectype,mglob, nglob @@ -64,11 +64,25 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila_(:), jla_(:) + logical :: dontcheck_ character(len=20) :: name info = psb_success_ name = 'psb_cdins' call psb_erractionsave(err_act) + if (present(dontcheck)) then + dontcheck_ = dontcheck + else + dontcheck_ = .false. + end if + + if (.not. dontcheck) then + if (.not.desc_a%is_bld()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + end if ictxt = desc_a%get_context() dectype = desc_a%get_dectype() @@ -79,12 +93,6 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) call psb_info(ictxt, me, np) - if (.not.desc_a%is_bld()) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - if (nz < 0) then info = 1111 call psb_errpush(info,name) @@ -121,7 +129,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) if (present(ila).and.present(jla)) then call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.) if (info == psb_success_) & - & call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0)) + & call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0),dontcheck=.true.) else if (present(ila).or.present(jla)) then write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla) @@ -134,7 +142,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) end if call psi_idx_cnv(nz,ia,ila_,desc_a,info,owned=.true.) if (info == psb_success_) & - & call psb_cdins(nz,ja,desc_a,info,mask=(ila_(1:nz)>0)) + & call psb_cdins(nz,ja,desc_a,info,mask=(ila_(1:nz)>0),dontcheck=.true.) deallocate(ila_) end if if (info /= psb_success_) goto 9999 @@ -168,7 +176,7 @@ end subroutine psb_cdinsrc ! mask(:) - logical, optional, target ! lidx(:) - integer(psb_ipk_), optional User-defined local col indices ! -subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) +subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) use psb_base_mod, psb_protect_name => psb_cdinsc use psi_mod implicit none @@ -180,6 +188,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) integer(psb_ipk_), optional, intent(out) :: jla(:) logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) + logical, intent(in), optional :: dontcheck !LOCALS..... @@ -190,13 +199,26 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila_(:), jla_(:) - logical, allocatable, target :: mask__(:) - logical, pointer :: mask_(:) + logical :: dontcheck_ character(len=20) :: name + info = psb_success_ name = 'psb_cdins' call psb_erractionsave(err_act) + if (present(dontcheck)) then + dontcheck_ = dontcheck + else + dontcheck_ = .false. + end if + + if (.not. dontcheck) then + if (.not.desc%is_bld()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif + end if ictxt = desc%get_context() dectype = desc%get_dectype() @@ -207,12 +229,6 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) call psb_info(ictxt, me, np) - if (.not.desc%is_bld()) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - if (nz < 0) then info = 1111 call psb_errpush(info,name) @@ -246,11 +262,6 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) call psb_errpush(info,name) goto 9999 end if -!!$ mask_ => mask -!!$ else -!!$ allocate(mask__(nz)) -!!$ mask_ => mask__ -!!$ mask_ = .true. end if if (present(jla)) then diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 550dadc0..4f2cd0b0 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -75,11 +75,11 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) name = 'psb_dspins' call psb_erractionsave(err_act) - if (.not.desc_a%is_ok()) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - end if +!!$ if (.not.desc_a%is_ok()) then +!!$ info = psb_err_invalid_cd_state_ +!!$ call psb_errpush(info,name) +!!$ goto 9999 +!!$ end if ictxt = desc_a%get_context() call psb_info(ictxt, me, np) @@ -133,7 +133,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) & a_err='allocate',i_err=ierr) goto 9999 end if - call psb_cdins(nz,ia,ja,desc_a,info,ila=ila,jla=jla) + call psb_cdins(nz,ia,ja,desc_a,info,ila=ila,jla=jla,dontcheck=.true.) if (info /= psb_success_) then ierr(1) = info @@ -284,7 +284,7 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_ar,info,iact='I',owned=.true.) - call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0)) + call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0),dontcheck=.true.) if (psb_errstatus_fatal()) then ierr(1) = info