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 interface psb_geasb
subroutine psb_casb(x, desc_a, info) subroutine psb_casb(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:,:) complex(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_casb end subroutine psb_casb
subroutine psb_casbv(x, desc_a, info) subroutine psb_casbv(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_spk_), allocatable, intent(inout) :: x(:) complex(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_casbv end subroutine psb_casbv
subroutine psb_casb_vect(x, desc_a, info,mold, scratch) subroutine psb_casb_vect(x, desc_a, info,mold, scratch)
import 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 interface psb_geasb
subroutine psb_dasb(x, desc_a, info) subroutine psb_dasb(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:,:) real(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_dasb end subroutine psb_dasb
subroutine psb_dasbv(x, desc_a, info) subroutine psb_dasbv(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_dpk_), allocatable, intent(inout) :: x(:) real(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_dasbv end subroutine psb_dasbv
subroutine psb_dasb_vect(x, desc_a, info,mold, scratch) subroutine psb_dasb_vect(x, desc_a, info,mold, scratch)
import 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 interface psb_geasb
subroutine psb_iasb(x, desc_a, info) subroutine psb_iasb(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(inout) :: x(:,:) integer(psb_ipk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_iasb end subroutine psb_iasb
subroutine psb_iasbv(x, desc_a, info) subroutine psb_iasbv(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), allocatable, intent(inout) :: x(:) integer(psb_ipk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_iasbv end subroutine psb_iasbv
subroutine psb_iasb_vect(x, desc_a, info,mold, scratch) subroutine psb_iasb_vect(x, desc_a, info,mold, scratch)
import 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 interface psb_geasb
subroutine psb_sasb(x, desc_a, info) subroutine psb_sasb(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:,:) real(psb_spk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_sasb end subroutine psb_sasb
subroutine psb_sasbv(x, desc_a, info) subroutine psb_sasbv(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
real(psb_spk_), allocatable, intent(inout) :: x(:) real(psb_spk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_sasbv end subroutine psb_sasbv
subroutine psb_sasb_vect(x, desc_a, info,mold, scratch) subroutine psb_sasb_vect(x, desc_a, info,mold, scratch)
import 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 interface psb_geasb
subroutine psb_zasb(x, desc_a, info) subroutine psb_zasb(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:,:) complex(psb_dpk_), allocatable, intent(inout) :: x(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_zasb end subroutine psb_zasb
subroutine psb_zasbv(x, desc_a, info) subroutine psb_zasbv(x, desc_a, info, scratch)
import import
implicit none implicit none
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
complex(psb_dpk_), allocatable, intent(inout) :: x(:) complex(psb_dpk_), allocatable, intent(inout) :: x(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: scratch
end subroutine psb_zasbv end subroutine psb_zasbv
subroutine psb_zasb_vect(x, desc_a, info,mold, scratch) subroutine psb_zasb_vect(x, desc_a, info,mold, scratch)
import import

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

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

Write Preview
Loading…
Cancel
Save