psblas3:

base/modules/psb_c_mat_mod.f90
 base/modules/psb_d_mat_mod.f90
 base/modules/psb_s_mat_mod.f90
 base/modules/psb_z_mat_mod.f90
 base/psblas/psb_cspnrm1.f90
 base/psblas/psb_dspnrm1.f90
 base/psblas/psb_sspnrm1.f90
 base/psblas/psb_zspnrm1.f90
 base/serial/impl/psb_c_mat_impl.F90
 base/serial/impl/psb_d_mat_impl.F90
 base/serial/impl/psb_s_mat_impl.F90
 base/serial/impl/psb_z_mat_impl.F90
 prec/impl/psb_c_diagprec_impl.f90
 prec/impl/psb_d_diagprec_impl.f90
 prec/impl/psb_s_diagprec_impl.f90
 prec/impl/psb_z_diagprec_impl.f90

Change rowsum & friends into functions. Fix preconditioners.

base/modules/psb_c_mat_mod.f90

@@ -761,50 +761,41 @@ module psb_c_mat_mod
   end interface
 
   interface 
-    subroutine psb_c_rowsum(d,a,info) 
+    function psb_c_rowsum(a,info) result(d)
       import :: psb_ipk_, psb_cspmat_type, psb_spk_
       class(psb_cspmat_type), intent(in) :: a
-      complex(psb_spk_), intent(out)     :: d(:)
+      complex(psb_spk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_c_rowsum
+    end function psb_c_rowsum
   end interface
 
   interface 
-    subroutine psb_c_arwsum(d,a,info) 
+    function psb_c_arwsum(a,info) result(d)
       import :: psb_ipk_, psb_cspmat_type, psb_spk_
       class(psb_cspmat_type), intent(in) :: a
-      real(psb_spk_), intent(out)        :: d(:)
+      real(psb_spk_), allocatable        :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_c_arwsum
+    end function psb_c_arwsum
   end interface
   
   interface 
-    subroutine psb_c_colsum(d,a,info) 
+    function psb_c_colsum(a,info) result(d)
       import :: psb_ipk_, psb_cspmat_type, psb_spk_
       class(psb_cspmat_type), intent(in) :: a
-      complex(psb_spk_), intent(out)     :: d(:)
+      complex(psb_spk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_c_colsum
+    end function psb_c_colsum
   end interface
 
   interface 
-    subroutine psb_c_aclsum(d,a,info) 
+    function psb_c_aclsum(a,info)  result(d)
       import :: psb_ipk_, psb_cspmat_type, psb_spk_
       class(psb_cspmat_type), intent(in) :: a
-      real(psb_spk_), intent(out)        :: d(:)
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine psb_c_aclsum
+      real(psb_spk_), allocatable        :: d(:)
+      integer(psb_ipk_), intent(out)        :: info
+    end function psb_c_aclsum
   end interface
 
-  
-!!$  interface 
-!!$    subroutine psb_c_get_diag(a,d,info)
-!!$      import :: psb_ipk_, psb_cspmat_type, psb_spk_
-!!$      class(psb_cspmat_type), intent(in) :: a
-!!$      complex(psb_spk_), intent(out)         :: d(:)
-!!$      integer(psb_ipk_), intent(out)                 :: info
-!!$    end subroutine psb_c_get_diag
-!!$  end interface
   interface 
     function psb_c_get_diag(a,info) result(d)
       import :: psb_ipk_, psb_cspmat_type, psb_spk_

base/modules/psb_d_mat_mod.f90

@@ -761,50 +761,41 @@ module psb_d_mat_mod
   end interface
 
   interface 
-    subroutine psb_d_rowsum(d,a,info) 
+    function psb_d_rowsum(a,info) result(d)
       import :: psb_ipk_, psb_dspmat_type, psb_dpk_
       class(psb_dspmat_type), intent(in) :: a
-      real(psb_dpk_), intent(out)     :: d(:)
+      real(psb_dpk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_d_rowsum
+    end function psb_d_rowsum
   end interface
 
   interface 
-    subroutine psb_d_arwsum(d,a,info) 
+    function psb_d_arwsum(a,info) result(d)
       import :: psb_ipk_, psb_dspmat_type, psb_dpk_
       class(psb_dspmat_type), intent(in) :: a
-      real(psb_dpk_), intent(out)        :: d(:)
+      real(psb_dpk_), allocatable        :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_d_arwsum
+    end function psb_d_arwsum
   end interface
   
   interface 
-    subroutine psb_d_colsum(d,a,info) 
+    function psb_d_colsum(a,info) result(d)
       import :: psb_ipk_, psb_dspmat_type, psb_dpk_
       class(psb_dspmat_type), intent(in) :: a
-      real(psb_dpk_), intent(out)     :: d(:)
+      real(psb_dpk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_d_colsum
+    end function psb_d_colsum
   end interface
 
   interface 
-    subroutine psb_d_aclsum(d,a,info) 
+    function psb_d_aclsum(a,info)  result(d)
       import :: psb_ipk_, psb_dspmat_type, psb_dpk_
       class(psb_dspmat_type), intent(in) :: a
-      real(psb_dpk_), intent(out)        :: d(:)
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine psb_d_aclsum
+      real(psb_dpk_), allocatable        :: d(:)
+      integer(psb_ipk_), intent(out)        :: info
+    end function psb_d_aclsum
   end interface
 
-  
-!!$  interface 
-!!$    subroutine psb_d_get_diag(a,d,info)
-!!$      import :: psb_ipk_, psb_dspmat_type, psb_dpk_
-!!$      class(psb_dspmat_type), intent(in) :: a
-!!$      real(psb_dpk_), intent(out)         :: d(:)
-!!$      integer(psb_ipk_), intent(out)                 :: info
-!!$    end subroutine psb_d_get_diag
-!!$  end interface
   interface 
     function psb_d_get_diag(a,info) result(d)
       import :: psb_ipk_, psb_dspmat_type, psb_dpk_

base/modules/psb_s_mat_mod.f90

@@ -761,50 +761,41 @@ module psb_s_mat_mod
   end interface
 
   interface 
-    subroutine psb_s_rowsum(d,a,info) 
+    function psb_s_rowsum(a,info) result(d)
       import :: psb_ipk_, psb_sspmat_type, psb_spk_
       class(psb_sspmat_type), intent(in) :: a
-      real(psb_spk_), intent(out)     :: d(:)
+      real(psb_spk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_s_rowsum
+    end function psb_s_rowsum
   end interface
 
   interface 
-    subroutine psb_s_arwsum(d,a,info) 
+    function psb_s_arwsum(a,info) result(d)
       import :: psb_ipk_, psb_sspmat_type, psb_spk_
       class(psb_sspmat_type), intent(in) :: a
-      real(psb_spk_), intent(out)        :: d(:)
+      real(psb_spk_), allocatable        :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_s_arwsum
+    end function psb_s_arwsum
   end interface
   
   interface 
-    subroutine psb_s_colsum(d,a,info) 
+    function psb_s_colsum(a,info) result(d)
       import :: psb_ipk_, psb_sspmat_type, psb_spk_
       class(psb_sspmat_type), intent(in) :: a
-      real(psb_spk_), intent(out)     :: d(:)
+      real(psb_spk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_s_colsum
+    end function psb_s_colsum
   end interface
 
   interface 
-    subroutine psb_s_aclsum(d,a,info) 
+    function psb_s_aclsum(a,info)  result(d)
       import :: psb_ipk_, psb_sspmat_type, psb_spk_
       class(psb_sspmat_type), intent(in) :: a
-      real(psb_spk_), intent(out)        :: d(:)
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine psb_s_aclsum
+      real(psb_spk_), allocatable        :: d(:)
+      integer(psb_ipk_), intent(out)        :: info
+    end function psb_s_aclsum
   end interface
 
-  
-!!$  interface 
-!!$    subroutine psb_s_get_diag(a,d,info)
-!!$      import :: psb_ipk_, psb_sspmat_type, psb_spk_
-!!$      class(psb_sspmat_type), intent(in) :: a
-!!$      real(psb_spk_), intent(out)         :: d(:)
-!!$      integer(psb_ipk_), intent(out)                 :: info
-!!$    end subroutine psb_s_get_diag
-!!$  end interface
   interface 
     function psb_s_get_diag(a,info) result(d)
       import :: psb_ipk_, psb_sspmat_type, psb_spk_

base/modules/psb_z_mat_mod.f90

@@ -761,50 +761,41 @@ module psb_z_mat_mod
   end interface
 
   interface 
-    subroutine psb_z_rowsum(d,a,info) 
+    function psb_z_rowsum(a,info) result(d)
       import :: psb_ipk_, psb_zspmat_type, psb_dpk_
       class(psb_zspmat_type), intent(in) :: a
-      complex(psb_dpk_), intent(out)     :: d(:)
+      complex(psb_dpk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_z_rowsum
+    end function psb_z_rowsum
   end interface
 
   interface 
-    subroutine psb_z_arwsum(d,a,info) 
+    function psb_z_arwsum(a,info) result(d)
       import :: psb_ipk_, psb_zspmat_type, psb_dpk_
       class(psb_zspmat_type), intent(in) :: a
-      real(psb_dpk_), intent(out)        :: d(:)
+      real(psb_dpk_), allocatable        :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_z_arwsum
+    end function psb_z_arwsum
   end interface
   
   interface 
-    subroutine psb_z_colsum(d,a,info) 
+    function psb_z_colsum(a,info) result(d)
       import :: psb_ipk_, psb_zspmat_type, psb_dpk_
       class(psb_zspmat_type), intent(in) :: a
-      complex(psb_dpk_), intent(out)     :: d(:)
+      complex(psb_dpk_), allocatable      :: d(:)
       integer(psb_ipk_), intent(out)               :: info
-    end subroutine psb_z_colsum
+    end function psb_z_colsum
   end interface
 
   interface 
-    subroutine psb_z_aclsum(d,a,info) 
+    function psb_z_aclsum(a,info)  result(d)
       import :: psb_ipk_, psb_zspmat_type, psb_dpk_
       class(psb_zspmat_type), intent(in) :: a
-      real(psb_dpk_), intent(out)        :: d(:)
-      integer(psb_ipk_), intent(out)              :: info
-    end subroutine psb_z_aclsum
+      real(psb_dpk_), allocatable        :: d(:)
+      integer(psb_ipk_), intent(out)        :: info
+    end function psb_z_aclsum
   end interface
 
-  
-!!$  interface 
-!!$    subroutine psb_z_get_diag(a,d,info)
-!!$      import :: psb_ipk_, psb_zspmat_type, psb_dpk_
-!!$      class(psb_zspmat_type), intent(in) :: a
-!!$      complex(psb_dpk_), intent(out)         :: d(:)
-!!$      integer(psb_ipk_), intent(out)                 :: info
-!!$    end subroutine psb_z_get_diag
-!!$  end interface
   interface 
     function psb_z_get_diag(a,info) result(d)
       import :: psb_ipk_, psb_zspmat_type, psb_dpk_

base/psblas/psb_cspnrm1.f90

@@ -91,20 +91,22 @@ function psb_cspnrm1(a,desc_a,info)  result(res)
     goto 9999
   end if
 
-  call psb_geall(v,desc_a,info)
-  if(info == psb_success_) then 
-    v = czero
-    call psb_geasb(v,desc_a,info)
-  end if
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='geall/asb'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
+!!$  call psb_geall(v,desc_a,info)
+!!$  if(info == psb_success_) then 
+!!$    v = czero
+!!$    call psb_geasb(v,desc_a,info)
+!!$  end if
+!!$  if(info /= psb_success_) then
+!!$    info=psb_err_from_subroutine_
+!!$    ch_err='geall/asb'
+!!$    call psb_errpush(info,name,a_err=ch_err)
+!!$    goto 9999
+!!$  end if
   
   if ((m /= 0).and.(n /= 0)) then
-    call a%aclsum(v,info)
+    v = a%aclsum(info)
+    if (info == psb_success_) &
+         & call psb_realloc(desc_a%get_local_cols(),v,info,pad=szero)
     if (info == psb_success_) call psb_halo(v,desc_a,info,tran='T')
     if(info /= psb_success_) then
       info=psb_err_from_subroutine_

base/psblas/psb_dspnrm1.f90

@@ -91,20 +91,22 @@ function psb_dspnrm1(a,desc_a,info)  result(res)
     goto 9999
   end if
 
-  call psb_geall(v,desc_a,info)
-  if(info == psb_success_) then 
-    v = dzero
-    call psb_geasb(v,desc_a,info)
-  end if
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='geall/asb'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
+!!$  call psb_geall(v,desc_a,info)
+!!$  if(info == psb_success_) then 
+!!$    v = dzero
+!!$    call psb_geasb(v,desc_a,info)
+!!$  end if
+!!$  if(info /= psb_success_) then
+!!$    info=psb_err_from_subroutine_
+!!$    ch_err='geall/asb'
+!!$    call psb_errpush(info,name,a_err=ch_err)
+!!$    goto 9999
+!!$  end if
   
   if ((m /= 0).and.(n /= 0)) then
-    call a%aclsum(v,info)
+    v = a%aclsum(info)
+    if (info == psb_success_) &
+         & call psb_realloc(desc_a%get_local_cols(),v,info,pad=dzero)
     if (info == psb_success_) call psb_halo(v,desc_a,info,tran='T')
     if(info /= psb_success_) then
       info=psb_err_from_subroutine_

base/psblas/psb_sspnrm1.f90

@@ -91,20 +91,22 @@ function psb_sspnrm1(a,desc_a,info)  result(res)
     goto 9999
   end if
 
-  call psb_geall(v,desc_a,info)
-  if(info == psb_success_) then 
-    v = szero
-    call psb_geasb(v,desc_a,info)
-  end if
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='geall/asb'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
+!!$  call psb_geall(v,desc_a,info)
+!!$  if(info == psb_success_) then 
+!!$    v = szero
+!!$    call psb_geasb(v,desc_a,info)
+!!$  end if
+!!$  if(info /= psb_success_) then
+!!$    info=psb_err_from_subroutine_
+!!$    ch_err='geall/asb'
+!!$    call psb_errpush(info,name,a_err=ch_err)
+!!$    goto 9999
+!!$  end if
   
   if ((m /= 0).and.(n /= 0)) then
-    call a%aclsum(v,info)
+    v = a%aclsum(info)
+    if (info == psb_success_) &
+         & call psb_realloc(desc_a%get_local_cols(),v,info,pad=szero)
     if (info == psb_success_) call psb_halo(v,desc_a,info,tran='T')
     if(info /= psb_success_) then
       info=psb_err_from_subroutine_

base/psblas/psb_zspnrm1.f90

@@ -91,20 +91,22 @@ function psb_zspnrm1(a,desc_a,info)  result(res)
     goto 9999
   end if
 
-  call psb_geall(v,desc_a,info)
-  if(info == psb_success_) then 
-    v = zzero
-    call psb_geasb(v,desc_a,info)
-  end if
-  if(info /= psb_success_) then
-    info=psb_err_from_subroutine_
-    ch_err='geall/asb'
-    call psb_errpush(info,name,a_err=ch_err)
-    goto 9999
-  end if
+!!$  call psb_geall(v,desc_a,info)
+!!$  if(info == psb_success_) then 
+!!$    v = zzero
+!!$    call psb_geasb(v,desc_a,info)
+!!$  end if
+!!$  if(info /= psb_success_) then
+!!$    info=psb_err_from_subroutine_
+!!$    ch_err='geall/asb'
+!!$    call psb_errpush(info,name,a_err=ch_err)
+!!$    goto 9999
+!!$  end if
   
   if ((m /= 0).and.(n /= 0)) then
-    call a%aclsum(v,info)
+    v = a%aclsum(info)
+    if (info == psb_success_) &
+         & call psb_realloc(desc_a%get_local_cols(),v,info,pad=dzero)
     if (info == psb_success_) call psb_halo(v,desc_a,info,tran='T')
     if(info /= psb_success_) then
       info=psb_err_from_subroutine_

base/serial/impl/psb_c_mat_impl.F90

@@ -2284,13 +2284,13 @@ function psb_c_csnm1(a) result(res)
 end function psb_c_csnm1
 
 
-subroutine psb_c_rowsum(d,a,info)
+function psb_c_rowsum(a,info) result(d)
   use psb_c_mat_mod, psb_protect_name => psb_c_rowsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_cspmat_type), intent(in) :: a
-  complex(psb_spk_), intent(out)     :: d(:)
+  complex(psb_spk_), allocatable     :: d(:)
   integer(psb_ipk_), intent(out)               :: info
 
   integer(psb_ipk_) :: err_act
@@ -2304,9 +2304,9 @@ subroutine psb_c_rowsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
-
-  call a%a%rowsum(d)
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
   if (info /= psb_success_) goto 9999
+  call a%a%rowsum(d)
 
   call psb_erractionrestore(err_act)
   return
@@ -2320,16 +2320,16 @@ subroutine psb_c_rowsum(d,a,info)
   end if
   return
 
-end subroutine psb_c_rowsum
+end function psb_c_rowsum
 
-subroutine psb_c_arwsum(d,a,info)
+function psb_c_arwsum(a,info) result(d)
   use psb_c_mat_mod, psb_protect_name => psb_c_arwsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_cspmat_type), intent(in) :: a
-  real(psb_spk_), intent(out)          :: d(:)
-  integer(psb_ipk_), intent(out)                 :: info
+  real(psb_spk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='arwsum'
@@ -2342,9 +2342,10 @@ subroutine psb_c_arwsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%arwsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2358,16 +2359,16 @@ subroutine psb_c_arwsum(d,a,info)
   end if
   return
 
-end subroutine psb_c_arwsum
+end function psb_c_arwsum
 
-subroutine psb_c_colsum(d,a,info)
+function psb_c_colsum(a,info) result(d)
   use psb_c_mat_mod, psb_protect_name => psb_c_colsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_cspmat_type), intent(in) :: a
-  complex(psb_spk_), intent(out)     :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  complex(psb_spk_), allocatable         :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='colsum'
@@ -2380,9 +2381,10 @@ subroutine psb_c_colsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%colsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2396,16 +2398,16 @@ subroutine psb_c_colsum(d,a,info)
   end if
   return
 
-end subroutine psb_c_colsum
+end function psb_c_colsum
 
-subroutine psb_c_aclsum(d,a,info)
+function psb_c_aclsum(a,info) result(d)
   use psb_c_mat_mod, psb_protect_name => psb_c_aclsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_cspmat_type), intent(in) :: a
-  real(psb_spk_), intent(out)        :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  real(psb_spk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='aclsum'
@@ -2418,9 +2420,10 @@ subroutine psb_c_aclsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%aclsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2434,48 +2437,9 @@ subroutine psb_c_aclsum(d,a,info)
   end if
   return
 
-end subroutine psb_c_aclsum
+end function psb_c_aclsum
 
 
-!!$
-!!$subroutine psb_c_get_diag(a,d,info)
-!!$  use psb_c_mat_mod, psb_protect_name => psb_c_get_diag
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  implicit none 
-!!$  class(psb_cspmat_type), intent(in) :: a
-!!$  complex(psb_spk_), intent(out)          :: d(:)
-!!$  integer(psb_ipk_), intent(out)                 :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='get_diag'
-!!$  logical, parameter :: debug=.false.
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (.not.allocated(a%a)) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  call a%a%get_diag(d,info)
-!!$  if (info /= psb_success_) goto 9999
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$9999 continue
-!!$  call psb_erractionrestore(err_act)
-!!$
-!!$  if (err_act == psb_act_abort_) then
-!!$    call psb_error()
-!!$    return
-!!$  end if
-!!$  return
-!!$
-!!$end subroutine psb_c_get_diag
-
 function psb_c_get_diag(a,info) result(d)
   use psb_c_mat_mod, psb_protect_name => psb_c_get_diag
   use psb_error_mod

base/serial/impl/psb_d_mat_impl.F90

@@ -2284,13 +2284,13 @@ function psb_d_csnm1(a) result(res)
 end function psb_d_csnm1
 
 
-subroutine psb_d_rowsum(d,a,info)
+function psb_d_rowsum(a,info) result(d)
   use psb_d_mat_mod, psb_protect_name => psb_d_rowsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_dspmat_type), intent(in) :: a
-  real(psb_dpk_), intent(out)     :: d(:)
+  real(psb_dpk_), allocatable     :: d(:)
   integer(psb_ipk_), intent(out)               :: info
 
   integer(psb_ipk_) :: err_act
@@ -2304,9 +2304,9 @@ subroutine psb_d_rowsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
-
-  call a%a%rowsum(d)
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
   if (info /= psb_success_) goto 9999
+  call a%a%rowsum(d)
 
   call psb_erractionrestore(err_act)
   return
@@ -2320,16 +2320,16 @@ subroutine psb_d_rowsum(d,a,info)
   end if
   return
 
-end subroutine psb_d_rowsum
+end function psb_d_rowsum
 
-subroutine psb_d_arwsum(d,a,info)
+function psb_d_arwsum(a,info) result(d)
   use psb_d_mat_mod, psb_protect_name => psb_d_arwsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_dspmat_type), intent(in) :: a
-  real(psb_dpk_), intent(out)          :: d(:)
-  integer(psb_ipk_), intent(out)                 :: info
+  real(psb_dpk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='arwsum'
@@ -2342,9 +2342,10 @@ subroutine psb_d_arwsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%arwsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2358,16 +2359,16 @@ subroutine psb_d_arwsum(d,a,info)
   end if
   return
 
-end subroutine psb_d_arwsum
+end function psb_d_arwsum
 
-subroutine psb_d_colsum(d,a,info)
+function psb_d_colsum(a,info) result(d)
   use psb_d_mat_mod, psb_protect_name => psb_d_colsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_dspmat_type), intent(in) :: a
-  real(psb_dpk_), intent(out)     :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  real(psb_dpk_), allocatable         :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='colsum'
@@ -2380,9 +2381,10 @@ subroutine psb_d_colsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%colsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2396,16 +2398,16 @@ subroutine psb_d_colsum(d,a,info)
   end if
   return
 
-end subroutine psb_d_colsum
+end function psb_d_colsum
 
-subroutine psb_d_aclsum(d,a,info)
+function psb_d_aclsum(a,info) result(d)
   use psb_d_mat_mod, psb_protect_name => psb_d_aclsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_dspmat_type), intent(in) :: a
-  real(psb_dpk_), intent(out)        :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  real(psb_dpk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='aclsum'
@@ -2418,9 +2420,10 @@ subroutine psb_d_aclsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%aclsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2434,48 +2437,9 @@ subroutine psb_d_aclsum(d,a,info)
   end if
   return
 
-end subroutine psb_d_aclsum
+end function psb_d_aclsum
 
 
-!!$
-!!$subroutine psb_d_get_diag(a,d,info)
-!!$  use psb_d_mat_mod, psb_protect_name => psb_d_get_diag
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  implicit none 
-!!$  class(psb_dspmat_type), intent(in) :: a
-!!$  real(psb_dpk_), intent(out)          :: d(:)
-!!$  integer(psb_ipk_), intent(out)                 :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='get_diag'
-!!$  logical, parameter :: debug=.false.
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (.not.allocated(a%a)) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  call a%a%get_diag(d,info)
-!!$  if (info /= psb_success_) goto 9999
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$9999 continue
-!!$  call psb_erractionrestore(err_act)
-!!$
-!!$  if (err_act == psb_act_abort_) then
-!!$    call psb_error()
-!!$    return
-!!$  end if
-!!$  return
-!!$
-!!$end subroutine psb_d_get_diag
-
 function psb_d_get_diag(a,info) result(d)
   use psb_d_mat_mod, psb_protect_name => psb_d_get_diag
   use psb_error_mod

base/serial/impl/psb_s_mat_impl.F90

@@ -2284,13 +2284,13 @@ function psb_s_csnm1(a) result(res)
 end function psb_s_csnm1
 
 
-subroutine psb_s_rowsum(d,a,info)
+function psb_s_rowsum(a,info) result(d)
   use psb_s_mat_mod, psb_protect_name => psb_s_rowsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_sspmat_type), intent(in) :: a
-  real(psb_spk_), intent(out)     :: d(:)
+  real(psb_spk_), allocatable     :: d(:)
   integer(psb_ipk_), intent(out)               :: info
 
   integer(psb_ipk_) :: err_act
@@ -2304,9 +2304,9 @@ subroutine psb_s_rowsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
-
-  call a%a%rowsum(d)
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
   if (info /= psb_success_) goto 9999
+  call a%a%rowsum(d)
 
   call psb_erractionrestore(err_act)
   return
@@ -2320,16 +2320,16 @@ subroutine psb_s_rowsum(d,a,info)
   end if
   return
 
-end subroutine psb_s_rowsum
+end function psb_s_rowsum
 
-subroutine psb_s_arwsum(d,a,info)
+function psb_s_arwsum(a,info) result(d)
   use psb_s_mat_mod, psb_protect_name => psb_s_arwsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_sspmat_type), intent(in) :: a
-  real(psb_spk_), intent(out)          :: d(:)
-  integer(psb_ipk_), intent(out)                 :: info
+  real(psb_spk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='arwsum'
@@ -2342,9 +2342,10 @@ subroutine psb_s_arwsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%arwsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2358,16 +2359,16 @@ subroutine psb_s_arwsum(d,a,info)
   end if
   return
 
-end subroutine psb_s_arwsum
+end function psb_s_arwsum
 
-subroutine psb_s_colsum(d,a,info)
+function psb_s_colsum(a,info) result(d)
   use psb_s_mat_mod, psb_protect_name => psb_s_colsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_sspmat_type), intent(in) :: a
-  real(psb_spk_), intent(out)     :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  real(psb_spk_), allocatable         :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='colsum'
@@ -2380,9 +2381,10 @@ subroutine psb_s_colsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%colsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2396,16 +2398,16 @@ subroutine psb_s_colsum(d,a,info)
   end if
   return
 
-end subroutine psb_s_colsum
+end function psb_s_colsum
 
-subroutine psb_s_aclsum(d,a,info)
+function psb_s_aclsum(a,info) result(d)
   use psb_s_mat_mod, psb_protect_name => psb_s_aclsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_sspmat_type), intent(in) :: a
-  real(psb_spk_), intent(out)        :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  real(psb_spk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='aclsum'
@@ -2418,9 +2420,10 @@ subroutine psb_s_aclsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%aclsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2434,48 +2437,9 @@ subroutine psb_s_aclsum(d,a,info)
   end if
   return
 
-end subroutine psb_s_aclsum
+end function psb_s_aclsum
 
 
-!!$
-!!$subroutine psb_s_get_diag(a,d,info)
-!!$  use psb_s_mat_mod, psb_protect_name => psb_s_get_diag
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  implicit none 
-!!$  class(psb_sspmat_type), intent(in) :: a
-!!$  real(psb_spk_), intent(out)          :: d(:)
-!!$  integer(psb_ipk_), intent(out)                 :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='get_diag'
-!!$  logical, parameter :: debug=.false.
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (.not.allocated(a%a)) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  call a%a%get_diag(d,info)
-!!$  if (info /= psb_success_) goto 9999
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$9999 continue
-!!$  call psb_erractionrestore(err_act)
-!!$
-!!$  if (err_act == psb_act_abort_) then
-!!$    call psb_error()
-!!$    return
-!!$  end if
-!!$  return
-!!$
-!!$end subroutine psb_s_get_diag
-
 function psb_s_get_diag(a,info) result(d)
   use psb_s_mat_mod, psb_protect_name => psb_s_get_diag
   use psb_error_mod

base/serial/impl/psb_z_mat_impl.F90

@@ -2284,13 +2284,13 @@ function psb_z_csnm1(a) result(res)
 end function psb_z_csnm1
 
 
-subroutine psb_z_rowsum(d,a,info)
+function psb_z_rowsum(a,info) result(d)
   use psb_z_mat_mod, psb_protect_name => psb_z_rowsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_zspmat_type), intent(in) :: a
-  complex(psb_dpk_), intent(out)     :: d(:)
+  complex(psb_dpk_), allocatable     :: d(:)
   integer(psb_ipk_), intent(out)               :: info
 
   integer(psb_ipk_) :: err_act
@@ -2304,9 +2304,9 @@ subroutine psb_z_rowsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
-
-  call a%a%rowsum(d)
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
   if (info /= psb_success_) goto 9999
+  call a%a%rowsum(d)
 
   call psb_erractionrestore(err_act)
   return
@@ -2320,16 +2320,16 @@ subroutine psb_z_rowsum(d,a,info)
   end if
   return
 
-end subroutine psb_z_rowsum
+end function psb_z_rowsum
 
-subroutine psb_z_arwsum(d,a,info)
+function psb_z_arwsum(a,info) result(d)
   use psb_z_mat_mod, psb_protect_name => psb_z_arwsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_zspmat_type), intent(in) :: a
-  real(psb_dpk_), intent(out)          :: d(:)
-  integer(psb_ipk_), intent(out)                 :: info
+  real(psb_dpk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='arwsum'
@@ -2342,9 +2342,10 @@ subroutine psb_z_arwsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_nrows())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%arwsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2358,16 +2359,16 @@ subroutine psb_z_arwsum(d,a,info)
   end if
   return
 
-end subroutine psb_z_arwsum
+end function psb_z_arwsum
 
-subroutine psb_z_colsum(d,a,info)
+function psb_z_colsum(a,info) result(d)
   use psb_z_mat_mod, psb_protect_name => psb_z_colsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_zspmat_type), intent(in) :: a
-  complex(psb_dpk_), intent(out)     :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  complex(psb_dpk_), allocatable         :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='colsum'
@@ -2380,9 +2381,10 @@ subroutine psb_z_colsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%colsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2396,16 +2398,16 @@ subroutine psb_z_colsum(d,a,info)
   end if
   return
 
-end subroutine psb_z_colsum
+end function psb_z_colsum
 
-subroutine psb_z_aclsum(d,a,info)
+function psb_z_aclsum(a,info) result(d)
   use psb_z_mat_mod, psb_protect_name => psb_z_aclsum
   use psb_error_mod
   use psb_const_mod
   implicit none 
   class(psb_zspmat_type), intent(in) :: a
-  real(psb_dpk_), intent(out)        :: d(:)
-  integer(psb_ipk_), intent(out)               :: info
+  real(psb_dpk_), allocatable           :: d(:)
+  integer(psb_ipk_), intent(out)       :: info
 
   integer(psb_ipk_) :: err_act
   character(len=20)  :: name='aclsum'
@@ -2418,9 +2420,10 @@ subroutine psb_z_aclsum(d,a,info)
     call psb_errpush(info,name)
     goto 9999
   endif
+  allocate(d(max(1,a%a%get_ncols())), stat=info)
+  if (info /= psb_success_) goto 9999
 
   call a%a%aclsum(d)
-  if (info /= psb_success_) goto 9999
 
   call psb_erractionrestore(err_act)
   return
@@ -2434,48 +2437,9 @@ subroutine psb_z_aclsum(d,a,info)
   end if
   return
 
-end subroutine psb_z_aclsum
+end function psb_z_aclsum
 
 
-!!$
-!!$subroutine psb_z_get_diag(a,d,info)
-!!$  use psb_z_mat_mod, psb_protect_name => psb_z_get_diag
-!!$  use psb_error_mod
-!!$  use psb_const_mod
-!!$  implicit none 
-!!$  class(psb_zspmat_type), intent(in) :: a
-!!$  complex(psb_dpk_), intent(out)          :: d(:)
-!!$  integer(psb_ipk_), intent(out)                 :: info
-!!$
-!!$  integer(psb_ipk_) :: err_act
-!!$  character(len=20)  :: name='get_diag'
-!!$  logical, parameter :: debug=.false.
-!!$
-!!$  info = psb_success_
-!!$  call psb_erractionsave(err_act)
-!!$  if (.not.allocated(a%a)) then 
-!!$    info = psb_err_invalid_mat_state_
-!!$    call psb_errpush(info,name)
-!!$    goto 9999
-!!$  endif
-!!$
-!!$  call a%a%get_diag(d,info)
-!!$  if (info /= psb_success_) goto 9999
-!!$
-!!$  call psb_erractionrestore(err_act)
-!!$  return
-!!$
-!!$9999 continue
-!!$  call psb_erractionrestore(err_act)
-!!$
-!!$  if (err_act == psb_act_abort_) then
-!!$    call psb_error()
-!!$    return
-!!$  end if
-!!$  return
-!!$
-!!$end subroutine psb_z_get_diag
-
 function psb_z_get_diag(a,info) result(d)
   use psb_z_mat_mod, psb_protect_name => psb_z_get_diag
   use psb_error_mod

prec/impl/psb_c_diagprec_impl.f90

@@ -264,14 +264,15 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     goto 9999
   end if
 
+  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=cone)
   do i=1,nrow
     if (prec%d(i) == dzero) then
-      prec%d(i) = done
+      prec%d(i) = cone
     else
-      prec%d(i) = done/prec%d(i)
+      prec%d(i) = cone/prec%d(i)
     endif
   end do
-  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=cone)
+
   allocate(prec%dv,stat=info) 
   if (info == 0) then 
     if (present(vmold)) then 

prec/impl/psb_d_diagprec_impl.f90

@@ -264,6 +264,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     goto 9999
   end if
 
+  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=done)
   do i=1,nrow
     if (prec%d(i) == dzero) then
       prec%d(i) = done
@@ -271,7 +272,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
       prec%d(i) = done/prec%d(i)
     endif
   end do
-  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=done)
+
   allocate(prec%dv,stat=info) 
   if (info == 0) then 
     if (present(vmold)) then 

prec/impl/psb_s_diagprec_impl.f90

@@ -264,14 +264,15 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     goto 9999
   end if
 
+  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=sone)
   do i=1,nrow
     if (prec%d(i) == dzero) then
-      prec%d(i) = done
+      prec%d(i) = sone
     else
-      prec%d(i) = done/prec%d(i)
+      prec%d(i) = sone/prec%d(i)
     endif
   end do
-  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=sone)
+
   allocate(prec%dv,stat=info) 
   if (info == 0) then 
     if (present(vmold)) then 

prec/impl/psb_z_diagprec_impl.f90

@@ -264,14 +264,15 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
     goto 9999
   end if
 
+  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=zone)
   do i=1,nrow
     if (prec%d(i) == dzero) then
-      prec%d(i) = done
+      prec%d(i) = zone
     else
-      prec%d(i) = done/prec%d(i)
+      prec%d(i) = zone/prec%d(i)
     endif
   end do
-  call psb_realloc(desc_a%get_local_cols(),prec%d,info,pad=zone)
+
   allocate(prec%dv,stat=info) 
   if (info == 0) then 
     if (present(vmold)) then