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

Use a CSR buffer in soc1_map_bld

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent 1e5e86ee89
commit dcb051d059
4 changed files with 136 additions and 92 deletions
Show Stats Download Patch File Download Diff File

57
mlprec/impl/aggregator/mld_c_soc1_map_bld.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),irow(nr),icol(nr),val(nr),stat=info)
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),&
& icol(nr),val(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),&
@ -124,18 +125,17 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
goto 9999
end if
call a%cp_to(acsr)
if (iorder == mld_aggr_ord_nat_) then
do i=1, nr
ilaggr(i) = -(nr+1)
idxs(i) = i
end do
else
call a%cp_to(acsr)
do i=1, nr
ilaggr(i) = -(nr+1)
ideg(i) = acsr%irp(i+1) - acsr%irp(i)
end do
call acsr%free()
call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
end if
@ -148,13 +148,16 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
step1: do ii=1, nr
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='csget')
goto 9999
end if
if (ilaggr(i) == -(nr+1)) then
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='csget')
!!$ goto 9999
!!$ end if
!
! Build the set of all strongly coupled nodes
@ -201,12 +204,15 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find the most strongly connected neighbour that is
! already aggregated, if any, and join its aggregate
@ -237,12 +243,15 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) < 0) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find its strongly connected neighbourhood not
! already aggregated, and make it into a new aggregate.
@ -285,7 +294,7 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
endif
if (naggr > ncol) then
write(0,*) name,'Error : naggr > ncol',naggr,ncol
!write(0,*) name,'Error : naggr > ncol',naggr,ncol
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
goto 9999
@ -311,6 +320,8 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call acsr%free()
call psb_erractionrestore(err_act)
return

57
mlprec/impl/aggregator/mld_d_soc1_map_bld.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),irow(nr),icol(nr),val(nr),stat=info)
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),&
& icol(nr),val(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),&
@ -124,18 +125,17 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
goto 9999
end if
call a%cp_to(acsr)
if (iorder == mld_aggr_ord_nat_) then
do i=1, nr
ilaggr(i) = -(nr+1)
idxs(i) = i
end do
else
call a%cp_to(acsr)
do i=1, nr
ilaggr(i) = -(nr+1)
ideg(i) = acsr%irp(i+1) - acsr%irp(i)
end do
call acsr%free()
call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
end if
@ -148,13 +148,16 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
step1: do ii=1, nr
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='csget')
goto 9999
end if
if (ilaggr(i) == -(nr+1)) then
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='csget')
!!$ goto 9999
!!$ end if
!
! Build the set of all strongly coupled nodes
@ -201,12 +204,15 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find the most strongly connected neighbour that is
! already aggregated, if any, and join its aggregate
@ -237,12 +243,15 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) < 0) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find its strongly connected neighbourhood not
! already aggregated, and make it into a new aggregate.
@ -285,7 +294,7 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
endif
if (naggr > ncol) then
write(0,*) name,'Error : naggr > ncol',naggr,ncol
!write(0,*) name,'Error : naggr > ncol',naggr,ncol
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
goto 9999
@ -311,6 +320,8 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call acsr%free()
call psb_erractionrestore(err_act)
return

57
mlprec/impl/aggregator/mld_s_soc1_map_bld.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),irow(nr),icol(nr),val(nr),stat=info)
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),&
& icol(nr),val(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),&
@ -124,18 +125,17 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
goto 9999
end if
call a%cp_to(acsr)
if (iorder == mld_aggr_ord_nat_) then
do i=1, nr
ilaggr(i) = -(nr+1)
idxs(i) = i
end do
else
call a%cp_to(acsr)
do i=1, nr
ilaggr(i) = -(nr+1)
ideg(i) = acsr%irp(i+1) - acsr%irp(i)
end do
call acsr%free()
call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
end if
@ -148,13 +148,16 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
step1: do ii=1, nr
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='csget')
goto 9999
end if
if (ilaggr(i) == -(nr+1)) then
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='csget')
!!$ goto 9999
!!$ end if
!
! Build the set of all strongly coupled nodes
@ -201,12 +204,15 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find the most strongly connected neighbour that is
! already aggregated, if any, and join its aggregate
@ -237,12 +243,15 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) < 0) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find its strongly connected neighbourhood not
! already aggregated, and make it into a new aggregate.
@ -285,7 +294,7 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
endif
if (naggr > ncol) then
write(0,*) name,'Error : naggr > ncol',naggr,ncol
!write(0,*) name,'Error : naggr > ncol',naggr,ncol
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
goto 9999
@ -311,6 +320,8 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call acsr%free()
call psb_erractionrestore(err_act)
return

57
mlprec/impl/aggregator/mld_z_soc1_map_bld.f90
Unescape Escape View File

@ -109,7 +109,8 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),irow(nr),icol(nr),val(nr),stat=info)
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),&
& icol(nr),val(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nr,izero,izero,izero,izero/),&
@ -124,18 +125,17 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
goto 9999
end if
call a%cp_to(acsr)
if (iorder == mld_aggr_ord_nat_) then
do i=1, nr
ilaggr(i) = -(nr+1)
idxs(i) = i
end do
else
call a%cp_to(acsr)
do i=1, nr
ilaggr(i) = -(nr+1)
ideg(i) = acsr%irp(i+1) - acsr%irp(i)
end do
call acsr%free()
call psb_msort(ideg,ix=idxs,dir=psb_sort_down_)
end if
@ -148,13 +148,16 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
step1: do ii=1, nr
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='csget')
goto 9999
end if
if (ilaggr(i) == -(nr+1)) then
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='csget')
!!$ goto 9999
!!$ end if
!
! Build the set of all strongly coupled nodes
@ -201,12 +204,15 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) == -(nr+1)) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find the most strongly connected neighbour that is
! already aggregated, if any, and join its aggregate
@ -237,12 +243,15 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
i = idxs(ii)
if (ilaggr(i) < 0) then
call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
if (info /= psb_success_) then
info=psb_err_from_subroutine_
call psb_errpush(info,name,a_err='psb_sp_getrow')
goto 9999
end if
nz = (acsr%irp(i+1)-acsr%irp(i))
icol(1:nz) = acsr%ja(acsr%irp(i):acsr%irp(i+1)-1)
val(1:nz) = acsr%val(acsr%irp(i):acsr%irp(i+1)-1)
!!$ call a%csget(i,i,nz,irow,icol,val,info,chksz=.false.)
!!$ if (info /= psb_success_) then
!!$ info=psb_err_from_subroutine_
!!$ call psb_errpush(info,name,a_err='psb_sp_getrow')
!!$ goto 9999
!!$ end if
!
! Find its strongly connected neighbourhood not
! already aggregated, and make it into a new aggregate.
@ -285,7 +294,7 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
endif
if (naggr > ncol) then
write(0,*) name,'Error : naggr > ncol',naggr,ncol
!write(0,*) name,'Error : naggr > ncol',naggr,ncol
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='Fatal error: naggr>ncol')
goto 9999
@ -311,6 +320,8 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
nlaggr(me+1) = naggr
call psb_sum(ictxt,nlaggr(1:np))
call acsr%free()
call psb_erractionrestore(err_act)
return

Write Preview
Loading…
Cancel
Save