From 9a21e21aeaae28f54e65020813b6071b997abd5f Mon Sep 17 00:00:00 2001
From: Salvatore Filippone <salvatore.filippone@cranfield.ac.uk>
Date: Wed, 6 Dec 2006 14:06:51 +0000
Subject: [PATCH] Debugged and fixed the building of the aggregate matrix for
 the option of raw aggregation.

---
 src/prec/psb_dbjac_aply.f90  |  6 ++++++
 src/prec/psb_dbldaggrmat.f90 | 14 ++++++++++----
 src/prec/psb_dprecbld.f90    | 17 ++++++++++++++---
 src/prec/psb_zbldaggrmat.f90 | 16 +++++++++++-----
 4 files changed, 41 insertions(+), 12 deletions(-)

diff --git a/src/prec/psb_dbjac_aply.f90 b/src/prec/psb_dbjac_aply.f90
index 72daabd2..5c3a20cd 100644
--- a/src/prec/psb_dbjac_aply.f90
+++ b/src/prec/psb_dbjac_aply.f90
@@ -190,6 +190,12 @@ subroutine psb_dbjac_aply(alpha,prec,x,beta,y,desc_data,trans,work,info)
 
     tx = dzero
     ty = dzero
+!!$        open(50+me)
+!!$        call psb_csprt(50+me,prec%av(ap_nd_))
+!!$        call flush(50+me)
+!!$        close(50+me)
+!!$        call psb_barrier(ictxt)
+
     select case(prec%iprcparm(f_type_)) 
     case(f_ilu_n_,f_ilu_e_) 
       do i=1, prec%iprcparm(jac_sweeps_) 
diff --git a/src/prec/psb_dbldaggrmat.f90 b/src/prec/psb_dbldaggrmat.f90
index b0c08f6e..c97798a5 100644
--- a/src/prec/psb_dbldaggrmat.f90
+++ b/src/prec/psb_dbldaggrmat.f90
@@ -46,7 +46,7 @@ subroutine psb_dbldaggrmat(a,desc_a,ac,desc_ac,p,info)
   implicit none
 
   type(psb_dspmat_type), intent(in), target  :: a
-  type(psb_dspmat_type), intent(out), target :: ac
+  type(psb_dspmat_type), intent(inout), target :: ac
   type(psb_desc_type), intent(in)            :: desc_a
   type(psb_desc_type), intent(inout)         :: desc_ac
   type(psb_dbaseprc_type), intent(inout), target  :: p
@@ -147,8 +147,8 @@ contains
       do i=1, nrow
         p%mlia(i) = p%mlia(i) + naggrm1
       end do
+      call psb_halo(p%mlia,desc_a,info)
     end if
-    call psb_halo(p%mlia,desc_a,info)
 
     if(info /= 0) then
       call psb_errpush(4010,name,a_err='psb_halo')
@@ -178,10 +178,16 @@ contains
 
     nzt = psb_sp_get_nnzeros(b)
 
+    j = 0 
     do i=1, nzt 
-      b%ia1(i) = p%mlia(b%ia1(i))
-      b%ia2(i) = p%mlia(b%ia2(i))
+      if ((1<=b%ia2(i)).and.(b%ia2(i)<=nrow)) then 
+        j = j + 1
+        b%aspk(j) = b%aspk(i)
+        b%ia1(j)  = p%mlia(b%ia1(i))
+        b%ia2(j)  = p%mlia(b%ia2(i))
+      end if
     enddo
+    b%infoa(psb_nnz_)=j
     call psb_fixcoo(b,info)
 
     nzt = psb_sp_get_nnzeros(b)
diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90
index 3bf250d4..3fd1a130 100644
--- a/src/prec/psb_dprecbld.f90
+++ b/src/prec/psb_dprecbld.f90
@@ -60,9 +60,9 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
   integer      :: int_err(5)
   character    :: iupd
 
-  logical, parameter :: debug=.false.
+  logical, parameter :: debug=.false., filedump=.false.
   integer,parameter  :: iroot=0,iout=60,ilout=40
-  character(len=20)   :: name, ch_err
+  character(len=20)   :: name, ch_err,dumpname
 
   if(psb_get_errstatus().ne.0) return 
   info=0
@@ -142,7 +142,18 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd)
       if (debug) then 
         write(0,*) 'Return from ',i-1,' call to mlprcbld ',info
       endif
-      
+      if (filedump) then 
+        write(dumpname,'(a,i2.2,a,i2.2,a)'),'ac_lev_',i,'.',me,'.out'
+        open(20,file=dumpname)
+        call psb_csprt(20,p%baseprecv(i)%av(ac_))
+        call flush(20) 
+        close(20)
+        write(dumpname,'(a,i2.2,a,i2.2,a)'),'nd_lev_',i,'.',me,'.out'
+        open(20,file=dumpname)
+        call psb_csprt(20,p%baseprecv(i)%av(ap_nd_))
+        call flush(20) 
+        close(20)
+      end if
     end do
 
   endif
diff --git a/src/prec/psb_zbldaggrmat.f90 b/src/prec/psb_zbldaggrmat.f90
index 0e46ae8d..fc525f71 100644
--- a/src/prec/psb_zbldaggrmat.f90
+++ b/src/prec/psb_zbldaggrmat.f90
@@ -47,7 +47,7 @@ subroutine psb_zbldaggrmat(a,desc_a,ac,desc_ac,p,info)
 
   type(psb_zspmat_type), intent(in), target  :: a
   type(psb_zbaseprc_type), intent(inout),target     :: p
-  type(psb_zspmat_type), intent(out), target :: ac
+  type(psb_zspmat_type), intent(inout), target :: ac
   type(psb_desc_type), intent(in)            :: desc_a
   type(psb_desc_type), intent(inout)         :: desc_ac
   integer, intent(out)                       :: info
@@ -112,7 +112,7 @@ contains
 
     include 'mpif.h'
     integer, intent(out)   :: info
-    type(psb_zspmat_type)          :: b, tmp
+    type(psb_zspmat_type)          :: b
     integer, pointer :: nzbr(:), idisp(:)
     integer :: ictxt, nrow, nglob, ncol, ntaggr, nzac, ip, ndx,&
          & naggr, np, me, nzt,jl,nzl,nlr,&
@@ -146,8 +146,8 @@ contains
       do i=1, nrow
         p%mlia(i) = p%mlia(i) + naggrm1
       end do
+      call psb_halo(p%mlia,desc_a,info)
     end if
-    call psb_halo(p%mlia,desc_a,info)
 
     if(info /= 0) then
       call psb_errpush(4010,name,a_err='psb_halo')
@@ -177,10 +177,16 @@ contains
 
     nzt = psb_sp_get_nnzeros(b)
 
+    j = 0 
     do i=1, nzt 
-      b%ia1(i) = p%mlia(b%ia1(i))
-      b%ia2(i) = p%mlia(b%ia2(i))
+      if ((1<=b%ia2(i)).and.(b%ia2(i)<=nrow)) then 
+        j = j + 1
+        b%aspk(j) = b%aspk(i)
+        b%ia1(j)  = p%mlia(b%ia1(i))
+        b%ia2(j)  = p%mlia(b%ia2(i))
+      end if
     enddo
+    b%infoa(psb_nnz_)=j
     call psb_fixcoo(b,info)
 
     nzt = psb_sp_get_nnzeros(b)