fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-18 03:42:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixed bug in raw aggregation, giving wild indices in the aggregated matrix.

Browse Source
This commit is contained in:
Salvatore Filippone
2006-11-30 13:51:57 +00:00
parent ac9ff90218
commit 8d26be773a
3 changed files with 36 additions and 115 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/prec/psb_dbjac_aply.f90
+1 -1
View File
@@ -73,7 +73,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
info = 0
call psb_erractionsave(err_act)
ictxt=desc_data%matrix_data(psb_ctxt_)
ictxt=psb_cd_get_context(desc_data)
call psb_info(ictxt, me, np)
diagl='U'
src/prec/psb_dbldaggrmat.f90
+18 -55
View File
@@ -147,14 +147,13 @@ contains
do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1
end do
call psb_halo(p%mlia,desc_a,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
goto 9999
end if
end if
call psb_halo(p%mlia,desc_a,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
goto 9999
end if
nzt = psb_sp_get_nnzeros(a)
@@ -169,57 +168,21 @@ contains
b%fida = 'COO'
b%m=a%m
b%k=a%k
if (.true.) then
call psb_csdp(a,b,info)
if(info /= 0) then
info=4010
ch_err='psb_csdp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
enddo
else
!!$ ! Ok, this is extremely dirty because we use pointers from
!!$ ! one sparse matrix into another. But it gives us something
!!$ ! in term of performance
!!$ jl = 0
!!$ do i=1,a%m,50
!!$ nlr = min(a%m-i+1,50)
!!$ call psb_spgtblk(i,a,b,info,append=.true.,iren=p%mlia,lrw=i+nlr-1)
!!$ if(info /= 0) then
!!$ call psb_errpush(4010,name,a_err='spgtblk')
!!$ goto 9999
!!$ end if
!!$
!!$ call psb_spinfo(psb_nztotreq_,b,nzl,info)
!!$ if(info /= 0) then
!!$ call psb_errpush(4010,name,a_err='spinfo')
!!$ goto 9999
!!$ end if
!!$ nzl = nzl - jl
!!$ tmp%fida = 'COO'
!!$ tmp%infoa(psb_nnz_) = nzl
!!$ tmp%aspk => b%aspk(jl+1:jl+nzl)
!!$ tmp%ia1 => b%ia1(jl+1:jl+nzl)
!!$ tmp%ia2 => b%ia2(jl+1:jl+nzl)
!!$ call psb_fixcoo(tmp,info)
!!$ if(info /= 0) then
!!$ call psb_errpush(4010,name,a_err='psb_fixcoo')
!!$ goto 9999
!!$ end if
!!$ nzl = tmp%infoa(psb_nnz_)
!!$ b%infoa(psb_nnz_) = jl+nzl
!!$ jl = jl + nzl
!!$ enddo
call psb_csdp(a,b,info)
if(info /= 0) then
info=4010
ch_err='psb_csdp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
enddo
call psb_fixcoo(b,info)
irs = psb_sp_get_nnzeros(b)
src/prec/psb_zbldaggrmat.f90
+17 -59
View File
@@ -146,14 +146,13 @@ contains
do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1
end do
call psb_halo(p%mlia,desc_a,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
goto 9999
end if
end if
call psb_halo(p%mlia,desc_a,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
goto 9999
end if
nzt = psb_sp_get_nnzeros(a)
@@ -168,63 +167,22 @@ contains
b%fida = 'COO'
b%m=a%m
b%k=a%k
if (.true.) then
call psb_csdp(a,b,info)
if(info /= 0) then
info=4010
ch_err='psb_csdp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
enddo
else
!!$ ! Ok, this is extremely dirty because we use pointers from
!!$ ! one sparse matrix into another. But it gives us something
!!$ ! in term of performance
!!$ jl = 0
!!$ do i=1,a%m,50
!!$ nlr = min(a%m-i+1,50)
!!$ call psb_spgtblk(i,a,b,info,append=.true.,iren=p%mlia,lrw=i+nlr-1)
!!$ if(info /= 0) then
!!$ call psb_errpush(4010,name,a_err='spgtblk')
!!$ goto 9999
!!$ end if
!!$
!!$ call psb_spinfo(psb_nztotreq_,b,nzl,info)
!!$ if(info /= 0) then
!!$ call psb_errpush(4010,name,a_err='spinfo')
!!$ goto 9999
!!$ end if
!!$ nzl = nzl - jl
!!$ tmp%fida = 'COO'
!!$ tmp%infoa(psb_nnz_) = nzl
!!$ tmp%aspk => b%aspk(jl+1:jl+nzl)
!!$ tmp%ia1 => b%ia1(jl+1:jl+nzl)
!!$ tmp%ia2 => b%ia2(jl+1:jl+nzl)
!!$ call psb_fixcoo(tmp,info)
!!$ if(info /= 0) then
!!$ call psb_errpush(4010,name,a_err='psb_fixcoo')
!!$ goto 9999
!!$ end if
!!$ nzl = tmp%infoa(psb_nnz_)
!!$ b%infoa(psb_nnz_) = jl+nzl
!!$ jl = jl + nzl
!!$ enddo
end if
call psb_fixcoo(b,info)
call psb_csdp(a,b,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='fixcoo')
info=4010
ch_err='psb_csdp'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
enddo
call psb_fixcoo(b,info)
irs = psb_sp_get_nnzeros(b)
call psb_sp_reall(b,irs,info)