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

psblas3-type-indexed
Salvatore Filippone 18 years ago
parent ac9ff90218
commit 8d26be773a

@ -73,7 +73,7 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
info = 0 info = 0
call psb_erractionsave(err_act) 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) call psb_info(ictxt, me, np)
diagl='U' diagl='U'

@ -147,14 +147,13 @@ contains
do i=1, nrow do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1 p%mlia(i) = p%mlia(i) + naggrm1
end do end do
end if
call psb_halo(p%mlia,desc_a,info) call psb_halo(p%mlia,desc_a,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo') call psb_errpush(4010,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
end if
nzt = psb_sp_get_nnzeros(a) nzt = psb_sp_get_nnzeros(a)
@ -169,7 +168,6 @@ contains
b%fida = 'COO' b%fida = 'COO'
b%m=a%m b%m=a%m
b%k=a%k b%k=a%k
if (.true.) then
call psb_csdp(a,b,info) call psb_csdp(a,b,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
@ -184,42 +182,7 @@ contains
b%ia1(i) = p%mlia(b%ia1(i)) b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i)) b%ia2(i) = p%mlia(b%ia2(i))
enddo enddo
call psb_fixcoo(b,info)
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
irs = psb_sp_get_nnzeros(b) irs = psb_sp_get_nnzeros(b)

@ -146,14 +146,13 @@ contains
do i=1, nrow do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1 p%mlia(i) = p%mlia(i) + naggrm1
end do end do
end if
call psb_halo(p%mlia,desc_a,info) call psb_halo(p%mlia,desc_a,info)
if(info /= 0) then if(info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo') call psb_errpush(4010,name,a_err='psb_halo')
goto 9999 goto 9999
end if end if
end if
nzt = psb_sp_get_nnzeros(a) nzt = psb_sp_get_nnzeros(a)
@ -168,7 +167,6 @@ contains
b%fida = 'COO' b%fida = 'COO'
b%m=a%m b%m=a%m
b%k=a%k b%k=a%k
if (.true.) then
call psb_csdp(a,b,info) call psb_csdp(a,b,info)
if(info /= 0) then if(info /= 0) then
info=4010 info=4010
@ -183,47 +181,7 @@ contains
b%ia1(i) = p%mlia(b%ia1(i)) b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i)) b%ia2(i) = p%mlia(b%ia2(i))
enddo 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_fixcoo(b,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='fixcoo')
goto 9999
end if
irs = psb_sp_get_nnzeros(b) irs = psb_sp_get_nnzeros(b)

Loading…
Cancel
Save