mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 20:32:12 +00:00
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.
This commit is contained in:
Salvatore Filippone
@@ -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_
|
||||
|
||||
+14
-12
@@ -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_
|
||||
|
||||
+14
-12
@@ -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_
|
||||
|
||||
+14
-12
@@ -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_
|
||||
|
||||
+14
-12
@@ -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,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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user