diff --git a/base/modules/psb_c_mat_mod.f90 b/base/modules/psb_c_mat_mod.f90 index bf16519c..76de3ef9 100644 --- a/base/modules/psb_c_mat_mod.f90 +++ b/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_ diff --git a/base/modules/psb_d_mat_mod.f90 b/base/modules/psb_d_mat_mod.f90 index 71e40052..df2ca9ee 100644 --- a/base/modules/psb_d_mat_mod.f90 +++ b/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_ diff --git a/base/modules/psb_s_mat_mod.f90 b/base/modules/psb_s_mat_mod.f90 index 10b60491..b3cce642 100644 --- a/base/modules/psb_s_mat_mod.f90 +++ b/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_ diff --git a/base/modules/psb_z_mat_mod.f90 b/base/modules/psb_z_mat_mod.f90 index 9b9f046c..a3c734e5 100644 --- a/base/modules/psb_z_mat_mod.f90 +++ b/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_ diff --git a/base/psblas/psb_cspnrm1.f90 b/base/psblas/psb_cspnrm1.f90 index 45812053..ec95af4d 100644 --- a/base/psblas/psb_cspnrm1.f90 +++ b/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_ diff --git a/base/psblas/psb_dspnrm1.f90 b/base/psblas/psb_dspnrm1.f90 index 0326eff7..2ec5547a 100644 --- a/base/psblas/psb_dspnrm1.f90 +++ b/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_ diff --git a/base/psblas/psb_sspnrm1.f90 b/base/psblas/psb_sspnrm1.f90 index 702026b8..082f1993 100644 --- a/base/psblas/psb_sspnrm1.f90 +++ b/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_ diff --git a/base/psblas/psb_zspnrm1.f90 b/base/psblas/psb_zspnrm1.f90 index 3e71ea5b..ee448632 100644 --- a/base/psblas/psb_zspnrm1.f90 +++ b/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_ diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 4db147dc..fd5d92b5 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/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,47 +2437,8 @@ subroutine psb_c_aclsum(d,a,info) end if return -end subroutine 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 +end function psb_c_aclsum + function psb_c_get_diag(a,info) result(d) use psb_c_mat_mod, psb_protect_name => psb_c_get_diag diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 15ac1467..c18d669d 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/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,47 +2437,8 @@ subroutine psb_d_aclsum(d,a,info) end if return -end subroutine 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 +end function psb_d_aclsum + function psb_d_get_diag(a,info) result(d) use psb_d_mat_mod, psb_protect_name => psb_d_get_diag diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index 81900c6c..b338faca 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/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,47 +2437,8 @@ subroutine psb_s_aclsum(d,a,info) end if return -end subroutine 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 +end function psb_s_aclsum + function psb_s_get_diag(a,info) result(d) use psb_s_mat_mod, psb_protect_name => psb_s_get_diag diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 131b312c..b3ca37a6 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/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,47 +2437,8 @@ subroutine psb_z_aclsum(d,a,info) end if return -end subroutine 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 +end function psb_z_aclsum + function psb_z_get_diag(a,info) result(d) use psb_z_mat_mod, psb_protect_name => psb_z_get_diag diff --git a/prec/impl/psb_c_diagprec_impl.f90 b/prec/impl/psb_c_diagprec_impl.f90 index d5973f35..00abde62 100644 --- a/prec/impl/psb_c_diagprec_impl.f90 +++ b/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 diff --git a/prec/impl/psb_d_diagprec_impl.f90 b/prec/impl/psb_d_diagprec_impl.f90 index 0d22625b..9e0e2ca8 100644 --- a/prec/impl/psb_d_diagprec_impl.f90 +++ b/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 diff --git a/prec/impl/psb_s_diagprec_impl.f90 b/prec/impl/psb_s_diagprec_impl.f90 index 89dfe215..a7e35326 100644 --- a/prec/impl/psb_s_diagprec_impl.f90 +++ b/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 diff --git a/prec/impl/psb_z_diagprec_impl.f90 b/prec/impl/psb_z_diagprec_impl.f90 index 990a66c5..9c0bf05d 100644 --- a/prec/impl/psb_z_diagprec_impl.f90 +++ b/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