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/modules/psb_cd_tools_mod.f90
 base/tools/psb_cdins.f90
 base/tools/psb_dspins.f90

Try to avoid multiple redundant checks in spins.
psblas-testmv
Salvatore Filippone 11 years ago
parent 31023c565a
commit 5e7c98a795
3 changed files with 46 additions and 33 deletions
Show Stats Download Patch File Download Diff File

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

@ -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

59
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)
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

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

@ -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

Write Preview
Loading…
Cancel
Save