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

Added scratch to geasb for arrays.

Browse Source
pull/1/head
Salvatore Filippone 7 years ago
parent f66a99f96e
commit f1d260b3c9
14 changed files with 164 additions and 94 deletions
Show Stats Download Patch File Download Diff File

6
base/modules/tools/psb_c_tools_mod.f90
Unescape Escape View File

@ -80,19 +80,21 @@ Module psb_c_tools_mod
interface psb_geasb
subroutine psb_casb(x, desc_a, info)
subroutine psb_casb(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_casb
subroutine psb_casbv(x, desc_a, info)
subroutine psb_casbv(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
import

6
base/modules/tools/psb_d_tools_mod.f90
Unescape Escape View File

@ -80,19 +80,21 @@ Module psb_d_tools_mod
interface psb_geasb
subroutine psb_dasb(x, desc_a, info)
subroutine psb_dasb(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_dasb
subroutine psb_dasbv(x, desc_a, info)
subroutine psb_dasbv(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_dasbv
subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
import

6
base/modules/tools/psb_i_tools_mod.f90
Unescape Escape View File

@ -79,19 +79,21 @@ Module psb_i_tools_mod
interface psb_geasb
subroutine psb_iasb(x, desc_a, info)
subroutine psb_iasb(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_iasb
subroutine psb_iasbv(x, desc_a, info)
subroutine psb_iasbv(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_iasbv
subroutine psb_iasb_vect(x, desc_a, info,mold, scratch)
import

6
base/modules/tools/psb_s_tools_mod.f90
Unescape Escape View File

@ -80,19 +80,21 @@ Module psb_s_tools_mod
interface psb_geasb
subroutine psb_sasb(x, desc_a, info)
subroutine psb_sasb(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_sasb
subroutine psb_sasbv(x, desc_a, info)
subroutine psb_sasbv(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
import

6
base/modules/tools/psb_z_tools_mod.f90
Unescape Escape View File

@ -80,19 +80,21 @@ Module psb_z_tools_mod
interface psb_geasb
subroutine psb_zasb(x, desc_a, info)
subroutine psb_zasb(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_zasb
subroutine psb_zasbv(x, desc_a, info)
subroutine psb_zasbv(x, desc_a, info, scratch)
import
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
import

2
base/tools/psb_c_map.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
!!$
!
!
!
!

44
base/tools/psb_casb.f90
Unescape Escape View File

@ -42,18 +42,20 @@
! x(:,:) - complex, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_casb(x, desc_a, info)
subroutine psb_casb(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_casb
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz, i2sz
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
@ -62,6 +64,8 @@ subroutine psb_casb(x, desc_a, info)
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_input_matrix_unassembled_
@ -107,13 +111,15 @@ subroutine psb_casb(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -170,18 +176,20 @@ end subroutine psb_casb
! x(:) - complex, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_casbv(x, desc_a, info)
subroutine psb_casbv(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_casbv
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name,ch_err
info = psb_success_
@ -191,6 +199,8 @@ subroutine psb_casbv(x, desc_a, info)
ictxt = desc_a%get_context()
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
@ -221,13 +231,15 @@ subroutine psb_casbv(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

2
base/tools/psb_d_map.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
!!$
!
!
!
!

44
base/tools/psb_dasb.f90
Unescape Escape View File

@ -42,18 +42,20 @@
! x(:,:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_dasb(x, desc_a, info)
subroutine psb_dasb(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_dasb
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz, i2sz
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
@ -62,6 +64,8 @@ subroutine psb_dasb(x, desc_a, info)
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_input_matrix_unassembled_
@ -107,13 +111,15 @@ subroutine psb_dasb(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -170,18 +176,20 @@ end subroutine psb_dasb
! x(:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_dasbv(x, desc_a, info)
subroutine psb_dasbv(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_dasbv
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name,ch_err
info = psb_success_
@ -191,6 +199,8 @@ subroutine psb_dasbv(x, desc_a, info)
ictxt = desc_a%get_context()
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
@ -221,13 +231,15 @@ subroutine psb_dasbv(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

44
base/tools/psb_iasb.f90
Unescape Escape View File

@ -42,18 +42,20 @@
! x(:,:) - integer, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_iasb(x, desc_a, info)
subroutine psb_iasb(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_iasb
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz, i2sz
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
@ -62,6 +64,8 @@ subroutine psb_iasb(x, desc_a, info)
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_input_matrix_unassembled_
@ -107,13 +111,15 @@ subroutine psb_iasb(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -170,18 +176,20 @@ end subroutine psb_iasb
! x(:) - integer, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_iasbv(x, desc_a, info)
subroutine psb_iasbv(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_iasbv
implicit none
type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name,ch_err
info = psb_success_
@ -191,6 +199,8 @@ subroutine psb_iasbv(x, desc_a, info)
ictxt = desc_a%get_context()
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
@ -221,13 +231,15 @@ subroutine psb_iasbv(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

2
base/tools/psb_s_map.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
!!$
!
!
!
!

44
base/tools/psb_sasb.f90
Unescape Escape View File

@ -42,18 +42,20 @@
! x(:,:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_sasb(x, desc_a, info)
subroutine psb_sasb(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_sasb
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz, i2sz
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
@ -62,6 +64,8 @@ subroutine psb_sasb(x, desc_a, info)
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_input_matrix_unassembled_
@ -107,13 +111,15 @@ subroutine psb_sasb(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -170,18 +176,20 @@ end subroutine psb_sasb
! x(:) - real, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_sasbv(x, desc_a, info)
subroutine psb_sasbv(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_sasbv
implicit none
type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name,ch_err
info = psb_success_
@ -191,6 +199,8 @@ subroutine psb_sasbv(x, desc_a, info)
ictxt = desc_a%get_context()
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
@ -221,13 +231,15 @@ subroutine psb_sasbv(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

2
base/tools/psb_z_map.f90
Unescape Escape View File

@ -29,7 +29,7 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
!!$
!
!
!
!

44
base/tools/psb_zasb.f90
Unescape Escape View File

@ -42,18 +42,20 @@
! x(:,:) - complex, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. return code
subroutine psb_zasb(x, desc_a, info)
subroutine psb_zasb(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_zasb
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me,nrow,ncol, err_act
integer(psb_ipk_) :: i1sz, i2sz
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
@ -62,6 +64,8 @@ subroutine psb_zasb(x, desc_a, info)
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
if (.not.psb_is_ok_desc(desc_a)) then
info=psb_err_input_matrix_unassembled_
@ -107,13 +111,15 @@ subroutine psb_zasb(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_halo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'
@ -170,18 +176,20 @@ end subroutine psb_zasb
! x(:) - complex, allocatable The matrix to be assembled.
! desc_a - type(psb_desc_type). The communication descriptor.
! info - integer. Return code
subroutine psb_zasbv(x, desc_a, info)
subroutine psb_zasbv(x, desc_a, info, scratch)
use psb_base_mod, psb_protect_name => psb_zasbv
implicit none
type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
! local variables
integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5), i1sz,nrow,ncol, err_act
integer(psb_ipk_) :: debug_level, debug_unit
logical :: scratch_
character(len=20) :: name,ch_err
info = psb_success_
@ -191,6 +199,8 @@ subroutine psb_zasbv(x, desc_a, info)
ictxt = desc_a%get_context()
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
scratch_ = .false.
if (present(scratch)) scratch_ = scratch
call psb_info(ictxt, me, np)
@ -221,13 +231,15 @@ subroutine psb_zasbv(x, desc_a, info)
endif
endif
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
if (.not.scratch_) then
! ..update halo elements..
call psb_halo(x,desc_a,info)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='f90_pshalo'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
end if
if (debug_level >= psb_debug_ext_) &
& write(debug_unit,*) me,' ',trim(name),': end'

Write Preview
Loading…
Cancel
Save