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

Transforming get_diag into a function returning an allocatable array.
psblas-3.2.0
Salvatore Filippone 11 years ago
parent c09edaf799
commit 1fe047609b
12 changed files with 272 additions and 172 deletions
Show Stats Download Patch File Download Diff File

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

@ -797,13 +797,21 @@ module psb_c_mat_mod
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
subroutine psb_c_get_diag(a,d,info) 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_
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_get_diag end function psb_c_get_diag
end interface end interface
interface psb_scal interface psb_scal

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

@ -797,13 +797,21 @@ module psb_d_mat_mod
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
subroutine psb_d_get_diag(a,d,info) 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_
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_get_diag end function psb_d_get_diag
end interface end interface
interface psb_scal interface psb_scal

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

@ -797,13 +797,21 @@ module psb_s_mat_mod
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
subroutine psb_s_get_diag(a,d,info) 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_
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_get_diag end function psb_s_get_diag
end interface end interface
interface psb_scal interface psb_scal

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

@ -797,13 +797,21 @@ module psb_z_mat_mod
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
subroutine psb_z_get_diag(a,d,info) 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_
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_get_diag end function psb_z_get_diag
end interface end interface
interface psb_scal interface psb_scal

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

@ -2437,13 +2437,52 @@ subroutine psb_c_aclsum(d,a,info)
end subroutine psb_c_aclsum end subroutine psb_c_aclsum
subroutine psb_c_get_diag(a,d,info) !!$
!!$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_c_mat_mod, psb_protect_name => psb_c_get_diag
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
@ -2457,7 +2496,12 @@ subroutine psb_c_get_diag(a,d,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,min(a%a%get_nrows(),a%a%get_ncols()))), stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%a%get_diag(d,info) call a%a%get_diag(d,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -2473,7 +2517,7 @@ subroutine psb_c_get_diag(a,d,info)
end if end if
return return
end subroutine psb_c_get_diag end function psb_c_get_diag
subroutine psb_c_scal(d,a,info,side) subroutine psb_c_scal(d,a,info,side)

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

@ -2437,13 +2437,52 @@ subroutine psb_d_aclsum(d,a,info)
end subroutine psb_d_aclsum end subroutine psb_d_aclsum
subroutine psb_d_get_diag(a,d,info) !!$
!!$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_d_mat_mod, psb_protect_name => psb_d_get_diag
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
@ -2457,7 +2496,12 @@ subroutine psb_d_get_diag(a,d,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,min(a%a%get_nrows(),a%a%get_ncols()))), stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%a%get_diag(d,info) call a%a%get_diag(d,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -2473,7 +2517,7 @@ subroutine psb_d_get_diag(a,d,info)
end if end if
return return
end subroutine psb_d_get_diag end function psb_d_get_diag
subroutine psb_d_scal(d,a,info,side) subroutine psb_d_scal(d,a,info,side)

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

@ -2437,13 +2437,52 @@ subroutine psb_s_aclsum(d,a,info)
end subroutine psb_s_aclsum end subroutine psb_s_aclsum
subroutine psb_s_get_diag(a,d,info) !!$
!!$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_s_mat_mod, psb_protect_name => psb_s_get_diag
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
@ -2457,7 +2496,12 @@ subroutine psb_s_get_diag(a,d,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,min(a%a%get_nrows(),a%a%get_ncols()))), stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%a%get_diag(d,info) call a%a%get_diag(d,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -2473,7 +2517,7 @@ subroutine psb_s_get_diag(a,d,info)
end if end if
return return
end subroutine psb_s_get_diag end function psb_s_get_diag
subroutine psb_s_scal(d,a,info,side) subroutine psb_s_scal(d,a,info,side)

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

@ -2437,13 +2437,52 @@ subroutine psb_z_aclsum(d,a,info)
end subroutine psb_z_aclsum end subroutine psb_z_aclsum
subroutine psb_z_get_diag(a,d,info) !!$
!!$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_z_mat_mod, psb_protect_name => psb_z_get_diag
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
@ -2457,7 +2496,12 @@ subroutine psb_z_get_diag(a,d,info)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif endif
allocate(d(max(1,min(a%a%get_nrows(),a%a%get_ncols()))), stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%a%get_diag(d,info) call a%a%get_diag(d,info)
if (info /= psb_success_) goto 9999 if (info /= psb_success_) goto 9999
@ -2473,7 +2517,7 @@ subroutine psb_z_get_diag(a,d,info)
end if end if
return return
end subroutine psb_z_get_diag end function psb_z_get_diag
subroutine psb_z_scal(d,a,info,side) subroutine psb_z_scal(d,a,info,side)

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

@ -111,29 +111,14 @@ subroutine psb_c_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
goto 9999 goto 9999
end if end if
if (size(work) >= x%get_nrows()) then
ww => work
else
allocate(ww(x%get_nrows()),stat=info)
if (info /= psb_success_) then
ierr(1) = x%get_nrows()
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=ierr,a_err='complex(psb_spk_)')
goto 9999
end if
end if
call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans) call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
if (size(work) < x%get_nrows()) then
deallocate(ww,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_, & call psb_errpush(psb_err_from_subroutine_, &
& name,a_err='Deallocate') & name,a_err='vect%mlt')
goto 9999 goto 9999
end if end if
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -270,22 +255,9 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
nrow = desc_a%get_local_cols() nrow = desc_a%get_local_rows()
if (allocated(prec%d)) then
if (size(prec%d) < nrow) then
deallocate(prec%d,stat=info)
end if
end if
if ((info == psb_success_).and.(.not.allocated(prec%d))) then
allocate(prec%d(nrow), stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%get_diag(prec%d,info) prec%d=a%get_diag(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_from_subroutine_ info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='get_diag') call psb_errpush(info,name, a_err='get_diag')
@ -299,6 +271,7 @@ subroutine psb_c_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=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

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

@ -111,29 +111,14 @@ subroutine psb_d_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
goto 9999 goto 9999
end if end if
if (size(work) >= x%get_nrows()) then
ww => work
else
allocate(ww(x%get_nrows()),stat=info)
if (info /= psb_success_) then
ierr(1) = x%get_nrows()
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=ierr,a_err='real(psb_dpk_)')
goto 9999
end if
end if
call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans) call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
if (size(work) < x%get_nrows()) then
deallocate(ww,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_, & call psb_errpush(psb_err_from_subroutine_, &
& name,a_err='Deallocate') & name,a_err='vect%mlt')
goto 9999 goto 9999
end if end if
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -270,22 +255,9 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
nrow = desc_a%get_local_cols() nrow = desc_a%get_local_rows()
if (allocated(prec%d)) then
if (size(prec%d) < nrow) then
deallocate(prec%d,stat=info)
end if
end if
if ((info == psb_success_).and.(.not.allocated(prec%d))) then
allocate(prec%d(nrow), stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%get_diag(prec%d,info) prec%d=a%get_diag(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_from_subroutine_ info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='get_diag') call psb_errpush(info,name, a_err='get_diag')
@ -299,6 +271,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

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

@ -111,29 +111,14 @@ subroutine psb_s_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
goto 9999 goto 9999
end if end if
if (size(work) >= x%get_nrows()) then
ww => work
else
allocate(ww(x%get_nrows()),stat=info)
if (info /= psb_success_) then
ierr(1) = x%get_nrows()
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=ierr,a_err='real(psb_spk_)')
goto 9999
end if
end if
call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans) call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
if (size(work) < x%get_nrows()) then
deallocate(ww,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_, & call psb_errpush(psb_err_from_subroutine_, &
& name,a_err='Deallocate') & name,a_err='vect%mlt')
goto 9999 goto 9999
end if end if
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -270,22 +255,9 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
nrow = desc_a%get_local_cols() nrow = desc_a%get_local_rows()
if (allocated(prec%d)) then
if (size(prec%d) < nrow) then
deallocate(prec%d,stat=info)
end if
end if
if ((info == psb_success_).and.(.not.allocated(prec%d))) then
allocate(prec%d(nrow), stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%get_diag(prec%d,info) prec%d=a%get_diag(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_from_subroutine_ info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='get_diag') call psb_errpush(info,name, a_err='get_diag')
@ -299,6 +271,7 @@ subroutine psb_s_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=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

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

@ -111,29 +111,14 @@ subroutine psb_z_diag_apply_vect(alpha,prec,x,beta,y,desc_data,info,trans,work)
goto 9999 goto 9999
end if end if
if (size(work) >= x%get_nrows()) then
ww => work
else
allocate(ww(x%get_nrows()),stat=info)
if (info /= psb_success_) then
ierr(1) = x%get_nrows()
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=ierr,a_err='complex(psb_dpk_)')
goto 9999
end if
end if
call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans) call y%mlt(alpha,prec%dv,x,beta,info,conjgx=trans)
if (size(work) < x%get_nrows()) then
deallocate(ww,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_, & call psb_errpush(psb_err_from_subroutine_, &
& name,a_err='Deallocate') & name,a_err='vect%mlt')
goto 9999 goto 9999
end if end if
end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return
@ -270,22 +255,9 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
nrow = desc_a%get_local_cols() nrow = desc_a%get_local_rows()
if (allocated(prec%d)) then
if (size(prec%d) < nrow) then
deallocate(prec%d,stat=info)
end if
end if
if ((info == psb_success_).and.(.not.allocated(prec%d))) then
allocate(prec%d(nrow), stat=info)
end if
if (info /= psb_success_) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%get_diag(prec%d,info) prec%d=a%get_diag(info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_from_subroutine_ info = psb_err_from_subroutine_
call psb_errpush(info,name, a_err='get_diag') call psb_errpush(info,name, a_err='get_diag')
@ -299,6 +271,7 @@ subroutine psb_z_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=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