fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-19 20:32:13 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed hybrid map bld.

Browse Source
This commit is contained in:
Salvatore Filippone
2018-05-11 14:32:48 +01:00
parent e58eab504e
commit 13f0954cab
4 changed files with 48 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/aggregator/mld_c_hyb_map_bld.f90
+12 -9
View File
@@ -86,7 +86,7 @@ subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
& ideg(:), idxs(:), tmpaggr(:)
complex(psb_spk_), allocatable :: val(:), diag(:)
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr,nc,naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
type(psb_c_csr_sparse_mat) :: acsr, muij, s_neigh
type(psb_c_coo_sparse_mat) :: s_neigh_coo
real(psb_spk_) :: cpling, tcl
@@ -109,6 +109,7 @@ subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
nc = a%get_ncols()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),icol(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
@@ -131,7 +132,7 @@ subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
end do
end do
!write(*,*) 'murows/cols ',maxval(mu_rows),maxval(mu_cols)
@@ -143,13 +144,15 @@ subroutine mld_c_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = sone
else
s_neigh_coo%val(ip) = -sone
if (j<=nr) then
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = sone
else
s_neigh_coo%val(ip) = -sone
end if
end if
end do
end do
mlprec/impl/aggregator/mld_d_hyb_map_bld.f90
+12 -9
View File
@@ -86,7 +86,7 @@ subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
& ideg(:), idxs(:), tmpaggr(:)
real(psb_dpk_), allocatable :: val(:), diag(:)
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr,nc,naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
type(psb_d_csr_sparse_mat) :: acsr, muij, s_neigh
type(psb_d_coo_sparse_mat) :: s_neigh_coo
real(psb_dpk_) :: cpling, tcl
@@ -109,6 +109,7 @@ subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
nc = a%get_ncols()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),icol(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
@@ -131,7 +132,7 @@ subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
end do
end do
!write(*,*) 'murows/cols ',maxval(mu_rows),maxval(mu_cols)
@@ -143,13 +144,15 @@ subroutine mld_d_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = done
else
s_neigh_coo%val(ip) = -done
if (j<=nr) then
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = done
else
s_neigh_coo%val(ip) = -done
end if
end if
end do
end do
mlprec/impl/aggregator/mld_s_hyb_map_bld.f90
+12 -9
View File
@@ -86,7 +86,7 @@ subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
& ideg(:), idxs(:), tmpaggr(:)
real(psb_spk_), allocatable :: val(:), diag(:)
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr,nc,naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
type(psb_s_csr_sparse_mat) :: acsr, muij, s_neigh
type(psb_s_coo_sparse_mat) :: s_neigh_coo
real(psb_spk_) :: cpling, tcl
@@ -109,6 +109,7 @@ subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
nc = a%get_ncols()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),icol(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
@@ -131,7 +132,7 @@ subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
end do
end do
!write(*,*) 'murows/cols ',maxval(mu_rows),maxval(mu_cols)
@@ -143,13 +144,15 @@ subroutine mld_s_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = sone
else
s_neigh_coo%val(ip) = -sone
if (j<=nr) then
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = sone
else
s_neigh_coo%val(ip) = -sone
end if
end if
end do
end do
mlprec/impl/aggregator/mld_z_hyb_map_bld.f90
+12 -9
View File
@@ -86,7 +86,7 @@ subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_), allocatable :: ils(:), neigh(:), irow(:), icol(:),&
& ideg(:), idxs(:), tmpaggr(:)
complex(psb_dpk_), allocatable :: val(:), diag(:)
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr, naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
integer(psb_ipk_) :: icnt,nlp,k,n,ia,isz,nr,nc,naggr,i,j,m, nz, ilg, ii, ip, ip1,nzcnt
type(psb_z_csr_sparse_mat) :: acsr, muij, s_neigh
type(psb_z_coo_sparse_mat) :: s_neigh_coo
real(psb_dpk_) :: cpling, tcl
@@ -109,6 +109,7 @@ subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
ncol = desc_a%get_local_cols()
nr = a%get_nrows()
nc = a%get_ncols()
allocate(ilaggr(nr),neigh(nr),ideg(nr),idxs(nr),icol(nr),stat=info)
if(info /= psb_success_) then
info=psb_err_alloc_request_
@@ -131,7 +132,7 @@ subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
if (j<= nr) muij%val(k) = abs(muij%val(k))/sqrt(abs(diag(i)*diag(j)))
end do
end do
!write(*,*) 'murows/cols ',maxval(mu_rows),maxval(mu_cols)
@@ -143,13 +144,15 @@ subroutine mld_z_hyb_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
do i=1, nr
do k=muij%irp(i),muij%irp(i+1)-1
j = muij%ja(k)
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = done
else
s_neigh_coo%val(ip) = -done
if (j<=nr) then
ip = ip + 1
s_neigh_coo%ia(ip) = i
s_neigh_coo%ja(ip) = j
if (real(muij%val(k)) >= theta) then
s_neigh_coo%val(ip) = done
else
s_neigh_coo%val(ip) = -done
end if
end if
end do
end do