From af68b32a2c4e18bdc9e066a215f3f1ab80da3d4f Mon Sep 17 00:00:00 2001
From: Michele Martone <michele.martone@ipp.mpg.de>
Date: Tue, 19 Apr 2011 13:12:38 +0000
Subject: [PATCH] psblas3-trunk: bugfix: psb_d_rsb_csgetptn returned nz=0.
 added a naive rscale/cscale handling in psb_d_rsb_csgetrow/psb_d_rsb_csgetrow

---
 opt/psb_d_rsb_mat_mod.F90 | 60 ++++++++++++++++++++++++++++++++-------
 1 file changed, 49 insertions(+), 11 deletions(-)

diff --git a/opt/psb_d_rsb_mat_mod.F90 b/opt/psb_d_rsb_mat_mod.F90
index 29ef9f85..6ce82a68 100644
--- a/opt/psb_d_rsb_mat_mod.F90
+++ b/opt/psb_d_rsb_mat_mod.F90
@@ -19,9 +19,11 @@ module psb_d_rsb_mat_mod
 #if 1
 #define PSBRSB_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
 #define PSBRSB_ERROR(MSG) write(*,*) __FILE__,':',__LINE__,':'," ERROR: ",MSG
+#define PSBRSB_WARNING(MSG) write(*,*) __FILE__,':',__LINE__,':'," WARNING: ",MSG
 #else
 #define PSBRSB_DEBUG(MSG)
 #define PSBRSB_ERROR(MSG)
+#define PSBRSB_WARNING(MSG)
 #endif
   integer, parameter :: c_d_typecode=68 ! FIXME: this is only valid for 'double'
   integer, parameter :: c_for_flags=1 ! : here should use RSB_FLAG_FORTRAN_INDICES_INTERFACE
@@ -34,6 +36,7 @@ module psb_d_rsb_mat_mod
   integer, parameter :: c_def_flags =c_for_flags ! FIXME: here should use ..
   integer :: c_f_order=c_for_flags        ! FIXME: here should use RSB_FLAG_WANT_COLUMN_MAJOR_ORDER
   integer, parameter :: c_upd_flags =c_for_flags ! flags for when updating the assembled rsb matrix
+  integer, parameter :: c_psbrsb_err_ =psb_err_internal_error_
   type, extends(psb_d_base_sparse_mat) :: psb_d_rsb_sparse_mat
 #ifdef HAVE_LIBRSB
     type(c_ptr) :: rsbmptr=c_null_ptr
@@ -655,6 +658,8 @@ subroutine psb_d_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
 
   if ((imax<imin).or.(jmax_<jmin_)) then 
     nz = 0
+    !info=c_psbrsb_err_ 
+    PSBRSB_WARNING("imax < imin ? or jmax < jmin ? !")
     return
   end if
 
@@ -678,12 +683,12 @@ subroutine psb_d_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
   else
     cscale_ = .false.
   endif
-  if ((rscale_.or.cscale_).and.(present(iren))) then 
-    PSBRSB_ERROR("!")
-    info = psb_err_many_optional_arg_
-    call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
-    goto 9999
-  end if
+!  if ((rscale_.or.cscale_).and.(present(iren))) then 
+!    PSBRSB_ERROR("!")
+!    info = psb_err_many_optional_arg_
+!    call psb_errpush(info,name,a_err='iren (rscale.or.cscale)')
+!    goto 9999
+!  end if
 
   nzrsb = rsb_get_block_nnz(a%rsbmptr,imin,imax,jmin_,jmax_,c_for_flags,info)
   ! FIXME: unfinished; missing error handling ..
@@ -691,16 +696,36 @@ subroutine psb_d_rsb_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
   call psb_ensure_size(nzin_+nzrsb,ia,info)
   if (info == psb_success_) call psb_ensure_size(nzin_+nzrsb,ja,info)
   if (info == psb_success_) call psb_ensure_size(nzin_+nzrsb,val,info)
-  if (info /= psb_success_) return
+  if (info /= psb_success_)then
+    PSBRSB_ERROR("psb_ensure_size failed !")
+    return
+  endif
   
+
   info=d_rsb_to_psb_info(rsb_get_block_sparse(a%rsbmptr,&
        & val(nzin_+1:),imin,imax,jmin_,jmax_,&
        & ia(nzin_+1:),ja(nzin_+1:),&
        & c_null_ptr,c_null_ptr,nz,c_for_flags))
     ! FIXME: unfinished; missing error handling ..
   if (nz /= nzrsb) then 
-    write(0,*) 'Mismatch in output from rsb_getblk: ',nz,nzrsb
+    info=c_psbrsb_err_ 
+    PSBRSB_ERROR("Mismatch in output from rsb_getblk")
+    write(*,*) 'Mismatch in output from rsb_getblk: ',nz,nzrsb
+ end if
+
+  if (rscale_) then 
+    do i=nzin_+1, nzin_+nz
+      ia(i) = ia(i) - imin + 1
+    end do
+  end if
+  if (cscale_) then 
+    do i=nzin_+1, nzin_+nz
+      ja(i) = ja(i) - jmin_ + 1
+    end do
   end if
+
+
+
 9999 continue
   call psb_erractionrestore(err_act)
 
@@ -764,11 +789,11 @@ subroutine psb_d_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
     if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
 
     if (info /= psb_success_) return
-    nzin_=rsb_get_block_nnz(a%rsbmptr,imin,imax,imin,imax,c_for_flags,info)
+    nz=rsb_get_block_nnz(a%rsbmptr,imin,imax,imin,imax,c_for_flags,info)
     ! FIXME: unfinished; missing error handling ..
 
-    call psb_ensure_size(nzin_,ia,info)
-    if (info == psb_success_) call psb_ensure_size(nzin_,ja,info)
+    call psb_ensure_size(nzin_+nz,ia,info)
+    if (info == psb_success_) call psb_ensure_size(nzin_+nz,ja,info)
     if (info /= psb_success_)then
       PSBRSB_ERROR("!")
       return
@@ -777,6 +802,19 @@ subroutine psb_d_rsb_csgetptn(imin,imax,a,nz,ia,ja,info,&
     info=d_rsb_to_psb_info(rsb_get_block_sparse_pattern&
     &(a%rsbmptr,imin,imax,jmin_,jmax_,ia,ja,c_null_ptr,c_null_ptr,nzin_,c_for_flags))
     ! FIXME: unfinished; missing error handling ..
+
+  if (rscale_) then 
+    do i=nzin_+1, nzin_+nz
+      ia(i) = ia(i) - imin + 1
+    end do
+  end if
+  if (cscale_) then 
+    do i=nzin_+1, nzin_+nz
+      ja(i) = ja(i) - jmin_ + 1
+    end do
+  end if
+
+
 end subroutine psb_d_rsb_csgetptn
 
 subroutine psb_d_rsb_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)