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()
call psb_info(ictxt, me, np)
if ((.not.allocated(desc%indxmap)).or.&
& (.not.desc%is_bld())) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
!!$
!!$ if ((.not.allocated(desc%indxmap)).or.&
!!$ & (.not.desc%is_bld())) then
!!$ info = psb_err_invalid_cd_state_
!!$ call psb_errpush(info,name)
!!$ goto 9999
!!$ endif
if (nv < 0) then
info = 1111
@ -219,12 +219,12 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask,lidx)
call psb_info(ictxt, me, np)
if ((.not.allocated(desc%indxmap)).or.&
& (.not.desc%is_bld())) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
!!$ if ((.not.allocated(desc%indxmap)).or.&
!!$ & (.not.desc%is_bld())) then
!!$ info = psb_err_invalid_cd_state_
!!$ call psb_errpush(info,name)
!!$ goto 9999
!!$ endif
if (nv < 0) then
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
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
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,dontcheck)
subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
import :: psb_ipk_, psb_desc_type
type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(in) :: nz,ja(:)
@ -107,7 +106,6 @@ 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

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

@ -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, dontcheck)
subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla)
use psb_base_mod, psb_protect_name => psb_cdinsrc
use psi_mod
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(out) :: info
integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:)
logical, intent(in), optional :: dontcheck
!LOCALS.....
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.
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
if (.not.desc_a%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
ictxt = desc_a%get_context()
dectype = desc_a%get_dectype()
@ -127,22 +118,31 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck)
end if
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_) &
& 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
if (present(ila).or.present(jla)) then
write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla)
endif
allocate(ila_(nz),stat=info)
allocate(ila_(nz),jla_(nz),stat=info)
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
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),dontcheck=.true.)
call desc_a%indxmap%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.)
if (info == psb_success_) then
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_)
end if
if (info /= psb_success_) goto 9999
@ -176,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,dontcheck)
subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx)
use psb_base_mod, psb_protect_name => psb_cdinsc
use psi_mod
implicit none
@ -188,7 +188,6 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
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.....
@ -199,26 +198,18 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
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%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
end if
if (.not.desc%is_bld()) then
info = psb_err_invalid_cd_state_
call psb_errpush(info,name)
goto 9999
endif
ictxt = desc%get_context()
dectype = desc%get_dectype()
@ -265,7 +256,9 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck)
end if
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
allocate(jla_(nz),stat=info)
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)
goto 9999
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_)
end if

18
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)
goto 9999
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
ierr(1) = info
@ -178,8 +180,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local)
goto 9999
end if
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(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 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)
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)
goto 9999
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 psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0),dontcheck=.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))
call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0))
if (psb_errstatus_fatal()) then
ierr(1) = info

Write Preview
Loading…
Cancel
Save