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

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'

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)
-      call psb_csdp(a,b,info)
+    if(info /= 0) then
-      if(info /= 0) then
+      info=4010
-        info=4010
+      ch_err='psb_csdp'
-        ch_err='psb_csdp'
+      call psb_errpush(info,name,a_err=ch_err)
-        call psb_errpush(info,name,a_err=ch_err)
+      goto 9999
-        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
 
+    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

@@ -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)
-      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)
     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)