From 8d26be773aeaead2f5daf9168a5aafc4bb8ae235 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 30 Nov 2006 13:51:57 +0000 Subject: [PATCH] Fixed bug in raw aggregation, giving wild indices in the aggregated matrix. --- src/prec/psb_dbjac_aply.f90 | 2 +- src/prec/psb_dbldaggrmat.f90 | 73 +++++++++------------------------- src/prec/psb_zbldaggrmat.f90 | 76 ++++++++---------------------------- 3 files changed, 36 insertions(+), 115 deletions(-) diff --git a/src/prec/psb_dbjac_aply.f90 b/src/prec/psb_dbjac_aply.f90 index 885909b3..72daabd2 100644 --- a/src/prec/psb_dbjac_aply.f90 +++ b/src/prec/psb_dbjac_aply.f90 @@ -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' diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90 index 3beb76ab..ac032f62 100644 --- a/src/prec/psb_dbldaggrmat.f90 +++ b/src/prec/psb_dbldaggrmat.f90 @@ -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) diff --git a/src/prec/psb_zbldaggrmat.f90 b/src/prec/psb_zbldaggrmat.f90 index d80aa855..45b2c777 100644 --- a/src/prec/psb_zbldaggrmat.f90 +++ b/src/prec/psb_zbldaggrmat.f90 @@ -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)