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

Fixed target attribute on A.

Browse Source
stopcriterion
Salvatore Filippone 18 years ago
parent 0436b0136f
commit 09830f6814
2 changed files with 433 additions and 363 deletions
Show Stats Download Patch File Download Diff File

47
mld_daggrmap_bld.f90
Unescape Escape View File

@ -40,24 +40,26 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
implicit none implicit none
integer, intent(in) :: aggr_type integer, intent(in) :: aggr_type
type(psb_dspmat_type), intent(in) :: a type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, allocatable :: ilaggr(:),nlaggr(:) integer, allocatable :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer, intent(out) :: info
! Locals ! Locals
integer, allocatable :: ils(:), neigh(:) integer, allocatable :: ils(:), neigh(:)
integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m
type(psb_dspmat_type), target :: atmp, atrans
type(psb_dspmat_type), pointer :: apnt
logical :: recovery logical :: recovery
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer ::ictxt,np,me,err_act integer :: ictxt,np,me,err_act
integer :: nrow, ncol, n_ne integer :: nrow, ncol, n_ne
integer, parameter :: one=1, two=2 integer, parameter :: one=1, two=2
character(len=20) :: name, ch_err character(len=20) :: name, ch_err
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name = 'mld_daggrmap_bld' name = 'mld_aggrmap_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Note. At the time being we are ignoring aggr_type ! Note. At the time being we are ignoring aggr_type
@ -69,6 +71,10 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nrow = psb_cd_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
select case (aggr_type)
case (dec_aggr_,sym_dec_aggr_)
nr = a%m nr = a%m
allocate(ilaggr(nr),neigh(nr),stat=info) allocate(ilaggr(nr),neigh(nr),stat=info)
if(info.ne.0) then if(info.ne.0) then
@ -81,6 +87,23 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr do i=1, nr
ilaggr(i) = -(nr+1) ilaggr(i) = -(nr+1)
end do end do
if (aggr_type == dec_aggr_) then
apnt => a
else
call psb_sp_clip(a,atmp,info,imax=nr,jmax=nr,&
& rscale=.false.,cscale=.false.)
atmp%m=nr
atmp%k=nr
call psb_transp(atmp,atrans,fmt='COO')
call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
atmp%m=nr
atmp%k=nr
call psb_sp_free(atrans,info)
call psb_ipcoo2csr(atmp,info)
apnt => atmp
end if
! Note: -(nr+1) Untouched as yet ! Note: -(nr+1) Untouched as yet
! -i 1<=i<=nr Adjacent to aggregate i ! -i 1<=i<=nr Adjacent to aggregate i
! i 1<=i<=nr Belonging to aggregate i ! i 1<=i<=nr Belonging to aggregate i
@ -103,7 +126,7 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
naggr = naggr + 1 naggr = naggr + 1
ilaggr(i) = naggr ilaggr(i) = naggr
call psb_neigh(a,i,neigh,n_ne,info,lev=one) call psb_neigh(apnt,i,neigh,n_ne,info,lev=one)
if (info/=0) then if (info/=0) then
info=4010 info=4010
ch_err='psb_neigh' ch_err='psb_neigh'
@ -121,7 +144,7 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! !
! 2. Untouched neighbours of these nodes are marked <0. ! 2. Untouched neighbours of these nodes are marked <0.
! !
call psb_neigh(a,i,neigh,n_ne,info,lev=two) call psb_neigh(apnt,i,neigh,n_ne,info,lev=two)
if (info/=0) then if (info/=0) then
info=4010 info=4010
ch_err='psb_neigh' ch_err='psb_neigh'
@ -184,7 +207,7 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
isz = nr+1 isz = nr+1
ia = -1 ia = -1
call psb_neigh(a,i,neigh,n_ne,info,lev=one) call psb_neigh(apnt,i,neigh,n_ne,info,lev=one)
if (info/=0) then if (info/=0) then
info=4010 info=4010
ch_err='psb_neigh' ch_err='psb_neigh'
@ -282,6 +305,18 @@ subroutine mld_daggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ictxt,nlaggr(1:np))
if (aggr_type == sym_dec_aggr_) then
call psb_sp_free(atmp,info)
end if
case default
write(0,*) 'Unimplemented aggregation algorithm ',aggr_type
info = -1
call psb_errpush(30,name,i_err=(/1,aggr_type,0,0,0/))
goto 9999
end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

45
mld_zaggrmap_bld.f90
Unescape Escape View File

@ -40,13 +40,15 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
implicit none implicit none
integer, intent(in) :: aggr_type integer, intent(in) :: aggr_type
type(psb_zspmat_type), intent(in) :: a type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer, allocatable :: ilaggr(:),nlaggr(:) integer, allocatable :: ilaggr(:),nlaggr(:)
integer, intent(out) :: info integer, intent(out) :: info
! Locals ! Locals
integer, allocatable :: ils(:), neigh(:) integer, allocatable :: ils(:), neigh(:)
integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m integer :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m
type(psb_zspmat_type), target :: atmp, atrans
type(psb_zspmat_type), pointer :: apnt
logical :: recovery logical :: recovery
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
@ -57,7 +59,7 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
if(psb_get_errstatus().ne.0) return if(psb_get_errstatus().ne.0) return
info=0 info=0
name = 'mld_zaggrmap_bld' name = 'mld_aggrmap_bld'
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
! !
! Note. At the time being we are ignoring aggr_type ! Note. At the time being we are ignoring aggr_type
@ -69,6 +71,10 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nrow = psb_cd_get_local_rows(desc_a) nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a) ncol = psb_cd_get_local_cols(desc_a)
select case (aggr_type)
case (dec_aggr_,sym_dec_aggr_)
nr = a%m nr = a%m
allocate(ilaggr(nr),neigh(nr),stat=info) allocate(ilaggr(nr),neigh(nr),stat=info)
if(info.ne.0) then if(info.ne.0) then
@ -81,6 +87,23 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr do i=1, nr
ilaggr(i) = -(nr+1) ilaggr(i) = -(nr+1)
end do end do
if (aggr_type == dec_aggr_) then
apnt => a
else
call psb_sp_clip(a,atmp,info,imax=nr,jmax=nr,&
& rscale=.false.,cscale=.false.)
atmp%m=nr
atmp%k=nr
call psb_transp(atmp,atrans,fmt='COO')
call psb_rwextd(nr,atmp,info,b=atrans,rowscale=.false.)
atmp%m=nr
atmp%k=nr
call psb_sp_free(atrans,info)
call psb_ipcoo2csr(atmp,info)
apnt => atmp
end if
! Note: -(nr+1) Untouched as yet ! Note: -(nr+1) Untouched as yet
! -i 1<=i<=nr Adjacent to aggregate i ! -i 1<=i<=nr Adjacent to aggregate i
! i 1<=i<=nr Belonging to aggregate i ! i 1<=i<=nr Belonging to aggregate i
@ -103,7 +126,7 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
naggr = naggr + 1 naggr = naggr + 1
ilaggr(i) = naggr ilaggr(i) = naggr
call psb_neigh(a,i,neigh,n_ne,info,lev=one) call psb_neigh(apnt,i,neigh,n_ne,info,lev=one)
if (info/=0) then if (info/=0) then
info=4010 info=4010
ch_err='psb_neigh' ch_err='psb_neigh'
@ -121,7 +144,7 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
! !
! 2. Untouched neighbours of these nodes are marked <0. ! 2. Untouched neighbours of these nodes are marked <0.
! !
call psb_neigh(a,i,neigh,n_ne,info,lev=two) call psb_neigh(apnt,i,neigh,n_ne,info,lev=two)
if (info/=0) then if (info/=0) then
info=4010 info=4010
ch_err='psb_neigh' ch_err='psb_neigh'
@ -184,7 +207,7 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
isz = nr+1 isz = nr+1
ia = -1 ia = -1
call psb_neigh(a,i,neigh,n_ne,info,lev=one) call psb_neigh(apnt,i,neigh,n_ne,info,lev=one)
if (info/=0) then if (info/=0) then
info=4010 info=4010
ch_err='psb_neigh' ch_err='psb_neigh'
@ -282,6 +305,18 @@ subroutine mld_zaggrmap_bld(aggr_type,a,desc_a,nlaggr,ilaggr,info)
nlaggr(me+1) = naggr nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np)) call psb_sum(ictxt,nlaggr(1:np))
if (aggr_type == sym_dec_aggr_) then
call psb_sp_free(atmp,info)
end if
case default
write(0,*) 'Unimplemented aggregation algorithm ',aggr_type
info = -1
call psb_errpush(30,name,i_err=(/1,aggr_type,0,0,0/))
goto 9999
end select
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

Write Preview
Loading…
Cancel
Save