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.
psblas-3.2.0
Salvatore Filippone 11 years ago
parent 1fe047609b
commit 2fe569381a

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Loading…
Cancel
Save