fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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
16 changed files with 218 additions and 386 deletions
Show Stats Download Patch File Download Diff File

33
base/modules/psb_c_mat_mod.f90
Unescape Escape View File

@ -761,50 +761,41 @@ module psb_c_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_c_rowsum end function psb_c_rowsum
end interface end interface
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_ import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_arwsum end function psb_c_arwsum
end interface end interface
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_ import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_c_colsum end function psb_c_colsum
end interface end interface
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_ import :: psb_ipk_, psb_cspmat_type, psb_spk_
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_aclsum end function psb_c_aclsum
end interface 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 interface
function psb_c_get_diag(a,info) result(d) function psb_c_get_diag(a,info) result(d)
import :: psb_ipk_, psb_cspmat_type, psb_spk_ import :: psb_ipk_, psb_cspmat_type, psb_spk_

33
base/modules/psb_d_mat_mod.f90
Unescape Escape View File

@ -761,50 +761,41 @@ module psb_d_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_d_rowsum end function psb_d_rowsum
end interface end interface
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_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_d_arwsum end function psb_d_arwsum
end interface end interface
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_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_d_colsum end function psb_d_colsum
end interface end interface
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_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_d_aclsum end function psb_d_aclsum
end interface 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 interface
function psb_d_get_diag(a,info) result(d) function psb_d_get_diag(a,info) result(d)
import :: psb_ipk_, psb_dspmat_type, psb_dpk_ import :: psb_ipk_, psb_dspmat_type, psb_dpk_

33
base/modules/psb_s_mat_mod.f90
Unescape Escape View File

@ -761,50 +761,41 @@ module psb_s_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_s_rowsum end function psb_s_rowsum
end interface end interface
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_ import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_s_arwsum end function psb_s_arwsum
end interface end interface
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_ import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_s_colsum end function psb_s_colsum
end interface end interface
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_ import :: psb_ipk_, psb_sspmat_type, psb_spk_
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_s_aclsum end function psb_s_aclsum
end interface 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 interface
function psb_s_get_diag(a,info) result(d) function psb_s_get_diag(a,info) result(d)
import :: psb_ipk_, psb_sspmat_type, psb_spk_ import :: psb_ipk_, psb_sspmat_type, psb_spk_

33
base/modules/psb_z_mat_mod.f90
Unescape Escape View File

@ -761,50 +761,41 @@ module psb_z_mat_mod
end interface end interface
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_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_z_rowsum end function psb_z_rowsum
end interface end interface
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_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:) real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_arwsum end function psb_z_arwsum
end interface end interface
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_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(in) :: a 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_), intent(out) :: info
end subroutine psb_z_colsum end function psb_z_colsum
end interface end interface
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_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:) real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_aclsum end function psb_z_aclsum
end interface 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 interface
function psb_z_get_diag(a,info) result(d) function psb_z_get_diag(a,info) result(d)
import :: psb_ipk_, psb_zspmat_type, psb_dpk_ import :: psb_ipk_, psb_zspmat_type, psb_dpk_

26
base/psblas/psb_cspnrm1.f90
Unescape Escape View File

@ -91,20 +91,22 @@ function psb_cspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
end if end if
call psb_geall(v,desc_a,info) !!$ call psb_geall(v,desc_a,info)
if(info == psb_success_) then !!$ if(info == psb_success_) then
v = czero !!$ v = czero
call psb_geasb(v,desc_a,info) !!$ call psb_geasb(v,desc_a,info)
end if !!$ end if
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
info=psb_err_from_subroutine_ !!$ info=psb_err_from_subroutine_
ch_err='geall/asb' !!$ ch_err='geall/asb'
call psb_errpush(info,name,a_err=ch_err) !!$ call psb_errpush(info,name,a_err=ch_err)
goto 9999 !!$ goto 9999
end if !!$ end if
if ((m /= 0).and.(n /= 0)) then 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_) call psb_halo(v,desc_a,info,tran='T')
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

26
base/psblas/psb_dspnrm1.f90
Unescape Escape View File

@ -91,20 +91,22 @@ function psb_dspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
end if end if
call psb_geall(v,desc_a,info) !!$ call psb_geall(v,desc_a,info)
if(info == psb_success_) then !!$ if(info == psb_success_) then
v = dzero !!$ v = dzero
call psb_geasb(v,desc_a,info) !!$ call psb_geasb(v,desc_a,info)
end if !!$ end if
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
info=psb_err_from_subroutine_ !!$ info=psb_err_from_subroutine_
ch_err='geall/asb' !!$ ch_err='geall/asb'
call psb_errpush(info,name,a_err=ch_err) !!$ call psb_errpush(info,name,a_err=ch_err)
goto 9999 !!$ goto 9999
end if !!$ end if
if ((m /= 0).and.(n /= 0)) then 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_) call psb_halo(v,desc_a,info,tran='T')
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

26
base/psblas/psb_sspnrm1.f90
Unescape Escape View File

@ -91,20 +91,22 @@ function psb_sspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
end if end if
call psb_geall(v,desc_a,info) !!$ call psb_geall(v,desc_a,info)
if(info == psb_success_) then !!$ if(info == psb_success_) then
v = szero !!$ v = szero
call psb_geasb(v,desc_a,info) !!$ call psb_geasb(v,desc_a,info)
end if !!$ end if
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
info=psb_err_from_subroutine_ !!$ info=psb_err_from_subroutine_
ch_err='geall/asb' !!$ ch_err='geall/asb'
call psb_errpush(info,name,a_err=ch_err) !!$ call psb_errpush(info,name,a_err=ch_err)
goto 9999 !!$ goto 9999
end if !!$ end if
if ((m /= 0).and.(n /= 0)) then 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_) call psb_halo(v,desc_a,info,tran='T')
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

26
base/psblas/psb_zspnrm1.f90
Unescape Escape View File

@ -91,20 +91,22 @@ function psb_zspnrm1(a,desc_a,info) result(res)
goto 9999 goto 9999
end if end if
call psb_geall(v,desc_a,info) !!$ call psb_geall(v,desc_a,info)
if(info == psb_success_) then !!$ if(info == psb_success_) then
v = zzero !!$ v = zzero
call psb_geasb(v,desc_a,info) !!$ call psb_geasb(v,desc_a,info)
end if !!$ end if
if(info /= psb_success_) then !!$ if(info /= psb_success_) then
info=psb_err_from_subroutine_ !!$ info=psb_err_from_subroutine_
ch_err='geall/asb' !!$ ch_err='geall/asb'
call psb_errpush(info,name,a_err=ch_err) !!$ call psb_errpush(info,name,a_err=ch_err)
goto 9999 !!$ goto 9999
end if !!$ end if
if ((m /= 0).and.(n /= 0)) then 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_) call psb_halo(v,desc_a,info,tran='T')
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_

76
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -2284,13 +2284,13 @@ function psb_c_csnm1(a) result(res)
end function psb_c_csnm1 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_c_mat_mod, psb_protect_name => psb_c_rowsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_cspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2304,9 +2304,9 @@ subroutine psb_c_rowsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
call a%a%rowsum(d)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2320,15 +2320,15 @@ subroutine psb_c_rowsum(d,a,info)
end if end if
return 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_c_mat_mod, psb_protect_name => psb_c_arwsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2342,9 +2342,10 @@ subroutine psb_c_arwsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d) call a%a%arwsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2358,15 +2359,15 @@ subroutine psb_c_arwsum(d,a,info)
end if end if
return 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_c_mat_mod, psb_protect_name => psb_c_colsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_cspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2380,9 +2381,10 @@ subroutine psb_c_colsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d) call a%a%colsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2396,15 +2398,15 @@ subroutine psb_c_colsum(d,a,info)
end if end if
return 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_c_mat_mod, psb_protect_name => psb_c_aclsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_cspmat_type), intent(in) :: a class(psb_cspmat_type), intent(in) :: a
real(psb_spk_), intent(out) :: d(:) real(psb_spk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2418,9 +2420,10 @@ subroutine psb_c_aclsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d) call a%a%aclsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2434,47 +2437,8 @@ subroutine psb_c_aclsum(d,a,info)
end if end if
return 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) function psb_c_get_diag(a,info) result(d)
use psb_c_mat_mod, psb_protect_name => psb_c_get_diag use psb_c_mat_mod, psb_protect_name => psb_c_get_diag

76
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -2284,13 +2284,13 @@ function psb_d_csnm1(a) result(res)
end function psb_d_csnm1 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_d_mat_mod, psb_protect_name => psb_d_rowsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2304,9 +2304,9 @@ subroutine psb_d_rowsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
call a%a%rowsum(d)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2320,15 +2320,15 @@ subroutine psb_d_rowsum(d,a,info)
end if end if
return 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_d_mat_mod, psb_protect_name => psb_d_arwsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2342,9 +2342,10 @@ subroutine psb_d_arwsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d) call a%a%arwsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2358,15 +2359,15 @@ subroutine psb_d_arwsum(d,a,info)
end if end if
return 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_d_mat_mod, psb_protect_name => psb_d_colsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2380,9 +2381,10 @@ subroutine psb_d_colsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d) call a%a%colsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2396,15 +2398,15 @@ subroutine psb_d_colsum(d,a,info)
end if end if
return 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_d_mat_mod, psb_protect_name => psb_d_aclsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_dspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2418,9 +2420,10 @@ subroutine psb_d_aclsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d) call a%a%aclsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2434,47 +2437,8 @@ subroutine psb_d_aclsum(d,a,info)
end if end if
return 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) function psb_d_get_diag(a,info) result(d)
use psb_d_mat_mod, psb_protect_name => psb_d_get_diag use psb_d_mat_mod, psb_protect_name => psb_d_get_diag

76
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -2284,13 +2284,13 @@ function psb_s_csnm1(a) result(res)
end function psb_s_csnm1 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_s_mat_mod, psb_protect_name => psb_s_rowsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2304,9 +2304,9 @@ subroutine psb_s_rowsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
call a%a%rowsum(d)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2320,15 +2320,15 @@ subroutine psb_s_rowsum(d,a,info)
end if end if
return 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_s_mat_mod, psb_protect_name => psb_s_arwsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2342,9 +2342,10 @@ subroutine psb_s_arwsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d) call a%a%arwsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2358,15 +2359,15 @@ subroutine psb_s_arwsum(d,a,info)
end if end if
return 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_s_mat_mod, psb_protect_name => psb_s_colsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2380,9 +2381,10 @@ subroutine psb_s_colsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d) call a%a%colsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2396,15 +2398,15 @@ subroutine psb_s_colsum(d,a,info)
end if end if
return 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_s_mat_mod, psb_protect_name => psb_s_aclsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_sspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2418,9 +2420,10 @@ subroutine psb_s_aclsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d) call a%a%aclsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2434,47 +2437,8 @@ subroutine psb_s_aclsum(d,a,info)
end if end if
return 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) function psb_s_get_diag(a,info) result(d)
use psb_s_mat_mod, psb_protect_name => psb_s_get_diag use psb_s_mat_mod, psb_protect_name => psb_s_get_diag

76
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -2284,13 +2284,13 @@ function psb_z_csnm1(a) result(res)
end function psb_z_csnm1 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_z_mat_mod, psb_protect_name => psb_z_rowsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_zspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2304,9 +2304,9 @@ subroutine psb_z_rowsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
call a%a%rowsum(d)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
call a%a%rowsum(d)
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2320,15 +2320,15 @@ subroutine psb_z_rowsum(d,a,info)
end if end if
return 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_z_mat_mod, psb_protect_name => psb_z_arwsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:) real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2342,9 +2342,10 @@ subroutine psb_z_arwsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_nrows())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%arwsum(d) call a%a%arwsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2358,15 +2359,15 @@ subroutine psb_z_arwsum(d,a,info)
end if end if
return 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_z_mat_mod, psb_protect_name => psb_z_colsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_zspmat_type), intent(in) :: a 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_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2380,9 +2381,10 @@ subroutine psb_z_colsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%colsum(d) call a%a%colsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2396,15 +2398,15 @@ subroutine psb_z_colsum(d,a,info)
end if end if
return 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_z_mat_mod, psb_protect_name => psb_z_aclsum
use psb_error_mod use psb_error_mod
use psb_const_mod use psb_const_mod
implicit none implicit none
class(psb_zspmat_type), intent(in) :: a class(psb_zspmat_type), intent(in) :: a
real(psb_dpk_), intent(out) :: d(:) real(psb_dpk_), allocatable :: d(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act integer(psb_ipk_) :: err_act
@ -2418,9 +2420,10 @@ subroutine psb_z_aclsum(d,a,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,a%a%get_ncols())), stat=info)
if (info /= psb_success_) goto 9999
call a%a%aclsum(d) call a%a%aclsum(d)
if (info /= psb_success_) goto 9999
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -2434,47 +2437,8 @@ subroutine psb_z_aclsum(d,a,info)
end if end if
return 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) function psb_z_get_diag(a,info) result(d)
use psb_z_mat_mod, psb_protect_name => psb_z_get_diag use psb_z_mat_mod, psb_protect_name => psb_z_get_diag

7
prec/impl/psb_c_diagprec_impl.f90
Unescape Escape View File

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

3
prec/impl/psb_d_diagprec_impl.f90
Unescape Escape View File

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

7
prec/impl/psb_s_diagprec_impl.f90
Unescape Escape View File

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

7
prec/impl/psb_z_diagprec_impl.f90
Unescape Escape View File

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

Write Preview
Loading…
Cancel
Save