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

psblas3:

Browse Source 
base/internals/psi_idx_ins_cnv.f90
 base/modules/psb_cd_tools_mod.f90
 base/tools/psb_cdins.f90
 base/tools/psb_dspins.f90


Test some performance fixes for glob_to_loc and matrix insertion.
psblas-testmv
Salvatore Filippone 11 years ago
parent 5e7c98a795
commit c407209ca7
4 changed files with 59 additions and 63 deletions
Show Stats Download Patch File Download Diff File

26
base/internals/psi_idx_ins_cnv.f90
Unescape Escape View File

@ -81,13 +81,13 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx)
ncol = desc%get_local_cols() ncol = desc%get_local_cols()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
!!$
if ((.not.allocated(desc%indxmap)).or.& !!$ if ((.not.allocated(desc%indxmap)).or.&
& (.not.desc%is_bld())) then !!$ & (.not.desc%is_bld())) then
info = psb_err_invalid_cd_state_ !!$ info = psb_err_invalid_cd_state_
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
endif !!$ endif
if (nv < 0) then if (nv < 0) then
info = 1111 info = 1111
@ -219,12 +219,12 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask,lidx)
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if ((.not.allocated(desc%indxmap)).or.& !!$ if ((.not.allocated(desc%indxmap)).or.&
& (.not.desc%is_bld())) then !!$ & (.not.desc%is_bld())) then
info = psb_err_invalid_cd_state_ !!$ info = psb_err_invalid_cd_state_
call psb_errpush(info,name) !!$ call psb_errpush(info,name)
goto 9999 !!$ goto 9999
endif !!$ endif
if (nv < 0) then if (nv < 0) then
info = 1111 info = 1111

6
base/modules/psb_cd_tools_mod.f90
Unescape Escape View File

@ -91,15 +91,14 @@ module psb_cd_tools_mod
end interface end interface
interface psb_cdins interface psb_cdins
subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla,dontcheck) subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc_a type(psb_desc_type), intent(inout) :: desc_a
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:)
logical, intent(in), optional :: dontcheck
end subroutine psb_cdinsrc end subroutine psb_cdinsrc
subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
import :: psb_ipk_, psb_desc_type import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(in) :: nz,ja(:) integer(psb_ipk_), intent(in) :: nz,ja(:)
@ -107,7 +106,6 @@ module psb_cd_tools_mod
integer(psb_ipk_), optional, intent(out) :: jla(:) integer(psb_ipk_), optional, intent(out) :: jla(:)
logical, optional, target, intent(in) :: mask(:) logical, optional, target, intent(in) :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:) integer(psb_ipk_), intent(in), optional :: lidx(:)
logical, intent(in), optional :: dontcheck
end subroutine psb_cdinsc end subroutine psb_cdinsc
end interface end interface

70
base/tools/psb_cdins.f90
Unescape Escape View File

@ -45,7 +45,7 @@
! ila(:) - integer(psb_ipk_), optional The row indices in local numbering ! ila(:) - integer(psb_ipk_), optional The row indices in local numbering
! jla(:) - integer(psb_ipk_), optional The col 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, dontcheck) subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
use psb_base_mod, psb_protect_name => psb_cdinsrc use psb_base_mod, psb_protect_name => psb_cdinsrc
use psi_mod use psi_mod
implicit none implicit none
@ -55,7 +55,6 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck)
integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:)
logical, intent(in), optional :: dontcheck
!LOCALS..... !LOCALS.....
integer(psb_ipk_) :: ictxt,dectype,mglob, nglob integer(psb_ipk_) :: ictxt,dectype,mglob, nglob
@ -64,25 +63,17 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila_(:), jla_(:) integer(psb_ipk_), allocatable :: ila_(:), jla_(:)
logical :: dontcheck_
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
name = 'psb_cdins' name = 'psb_cdins'
call psb_erractionsave(err_act) 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
if (.not.desc_a%is_bld()) then info = psb_err_invalid_cd_state_
info = psb_err_invalid_cd_state_ call psb_errpush(info,name)
call psb_errpush(info,name) goto 9999
goto 9999 endif
endif
end if
ictxt = desc_a%get_context() ictxt = desc_a%get_context()
dectype = desc_a%get_dectype() dectype = desc_a%get_dectype()
@ -127,22 +118,31 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck)
end if end if
if (present(ila).and.present(jla)) then if (present(ila).and.present(jla)) then
call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.) call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
if (info == psb_success_) & if (info == psb_success_) &
& call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0),dontcheck=.true.) & call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
!!$ 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))
else else
if (present(ila).or.present(jla)) then if (present(ila).or.present(jla)) then
write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla) write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla)
endif endif
allocate(ila_(nz),stat=info) allocate(ila_(nz),jla_(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call psi_idx_cnv(nz,ia,ila_,desc_a,info,owned=.true.) call desc_a%indxmap%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
if (info == psb_success_) & if (info == psb_success_) then
& call psb_cdins(nz,ja,desc_a,info,mask=(ila_(1:nz)>0),dontcheck=.true.) jla_(1:nz) = ja(1:nz)
call desc_a%indxmap%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0))
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))
deallocate(ila_) deallocate(ila_)
end if end if
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -176,7 +176,7 @@ end subroutine psb_cdinsrc
! mask(:) - logical, optional, target ! mask(:) - logical, optional, target
! lidx(:) - integer(psb_ipk_), optional User-defined local col indices ! lidx(:) - integer(psb_ipk_), optional User-defined local col indices
! !
subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
use psb_base_mod, psb_protect_name => psb_cdinsc use psb_base_mod, psb_protect_name => psb_cdinsc
use psi_mod use psi_mod
implicit none implicit none
@ -188,7 +188,6 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
integer(psb_ipk_), optional, intent(out) :: jla(:) integer(psb_ipk_), optional, intent(out) :: jla(:)
logical, optional, target, intent(in) :: mask(:) logical, optional, target, intent(in) :: mask(:)
integer(psb_ipk_), intent(in), optional :: lidx(:) integer(psb_ipk_), intent(in), optional :: lidx(:)
logical, intent(in), optional :: dontcheck
!LOCALS..... !LOCALS.....
@ -199,26 +198,18 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
integer(psb_ipk_), allocatable :: ila_(:), jla_(:) integer(psb_ipk_), allocatable :: ila_(:), jla_(:)
logical :: dontcheck_
character(len=20) :: name character(len=20) :: name
info = psb_success_ info = psb_success_
name = 'psb_cdins' name = 'psb_cdins'
call psb_erractionsave(err_act) 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
if (.not.desc%is_bld()) then info = psb_err_invalid_cd_state_
info = psb_err_invalid_cd_state_ call psb_errpush(info,name)
call psb_errpush(info,name) goto 9999
goto 9999 endif
endif
end if
ictxt = desc%get_context() ictxt = desc%get_context()
dectype = desc%get_dectype() dectype = desc%get_dectype()
@ -265,7 +256,9 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
end if end if
if (present(jla)) then if (present(jla)) then
call psi_idx_ins_cnv(nz,ja,jla,desc,info,mask=mask,lidx=lidx) !!$ call psi_idx_ins_cnv(nz,ja,jla,desc,info,mask=mask,lidx=lidx)
call desc%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx)
else else
allocate(jla_(nz),stat=info) allocate(jla_(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -273,7 +266,8 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
call psi_idx_ins_cnv(nz,ja,jla_,desc,info,mask=mask,lidx=lidx) !!$ call psi_idx_ins_cnv(nz,ja,jla_,desc,info,mask=mask,lidx=lidx)
call desc%indxmap%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx)
deallocate(jla_) deallocate(jla_)
end if end if

16
base/tools/psb_dspins.f90
Unescape Escape View File

@ -133,7 +133,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=ierr)
goto 9999 goto 9999
end if end if
call psb_cdins(nz,ia,ja,desc_a,info,ila=ila,jla=jla,dontcheck=.true.) !!$ call psb_cdins(nz,ia,ja,desc_a,info,ila=ila,jla=jla,good_desc=.true.)
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0))
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info ierr(1) = info
@ -178,8 +180,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
goto 9999 goto 9999
end if end if
call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_a,info,iact='I') !!$ call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_a,info,iact='I')
call psb_glob_to_loc(ja(1:nz),jla(1:nz),desc_a,info,iact='I') !!$ call psb_glob_to_loc(ja(1:nz),jla(1:nz),desc_a,info,iact='I')
call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info)
call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info)
call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -280,11 +284,11 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
& a_err='allocate',i_err=ierr) & a_err='allocate',i_err=ierr)
goto 9999 goto 9999
end if end if
ila(1:nz) = ia(1:nz)
call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_ar,info,iact='I',owned=.true.) call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.)
call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0),dontcheck=.true.) !!$ call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0))
call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
ierr(1) = info ierr(1) = info

Write Preview
Loading…
Cancel
Save