From f1d260b3c908abeace32a1799264315e3ef46985 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 21 Sep 2017 15:57:55 +0100 Subject: [PATCH] Added scratch to geasb for arrays. --- base/modules/tools/psb_c_tools_mod.f90 | 6 ++-- base/modules/tools/psb_d_tools_mod.f90 | 6 ++-- base/modules/tools/psb_i_tools_mod.f90 | 6 ++-- base/modules/tools/psb_s_tools_mod.f90 | 6 ++-- base/modules/tools/psb_z_tools_mod.f90 | 6 ++-- base/tools/psb_c_map.f90 | 2 +- base/tools/psb_casb.f90 | 44 ++++++++++++++++---------- base/tools/psb_d_map.f90 | 2 +- base/tools/psb_dasb.f90 | 44 ++++++++++++++++---------- base/tools/psb_iasb.f90 | 44 ++++++++++++++++---------- base/tools/psb_s_map.f90 | 2 +- base/tools/psb_sasb.f90 | 44 ++++++++++++++++---------- base/tools/psb_z_map.f90 | 2 +- base/tools/psb_zasb.f90 | 44 ++++++++++++++++---------- 14 files changed, 164 insertions(+), 94 deletions(-) diff --git a/base/modules/tools/psb_c_tools_mod.f90 b/base/modules/tools/psb_c_tools_mod.f90 index f1c25f16..f24c5b72 100644 --- a/base/modules/tools/psb_c_tools_mod.f90 +++ b/base/modules/tools/psb_c_tools_mod.f90 @@ -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 diff --git a/base/modules/tools/psb_d_tools_mod.f90 b/base/modules/tools/psb_d_tools_mod.f90 index e0828058..d71d86da 100644 --- a/base/modules/tools/psb_d_tools_mod.f90 +++ b/base/modules/tools/psb_d_tools_mod.f90 @@ -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 diff --git a/base/modules/tools/psb_i_tools_mod.f90 b/base/modules/tools/psb_i_tools_mod.f90 index 1df25467..7289b12a 100644 --- a/base/modules/tools/psb_i_tools_mod.f90 +++ b/base/modules/tools/psb_i_tools_mod.f90 @@ -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 diff --git a/base/modules/tools/psb_s_tools_mod.f90 b/base/modules/tools/psb_s_tools_mod.f90 index 6e5c902c..fb1e7c62 100644 --- a/base/modules/tools/psb_s_tools_mod.f90 +++ b/base/modules/tools/psb_s_tools_mod.f90 @@ -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 diff --git a/base/modules/tools/psb_z_tools_mod.f90 b/base/modules/tools/psb_z_tools_mod.f90 index 19a0f714..d36d49ca 100644 --- a/base/modules/tools/psb_z_tools_mod.f90 +++ b/base/modules/tools/psb_z_tools_mod.f90 @@ -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 diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index 581c6315..1742e522 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -!!$ +! ! ! ! diff --git a/base/tools/psb_casb.f90 b/base/tools/psb_casb.f90 index 9550d93a..c005cff0 100644 --- a/base/tools/psb_casb.f90 +++ b/base/tools/psb_casb.f90 @@ -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' diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 42dcf38a..b10f27ad 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -!!$ +! ! ! ! diff --git a/base/tools/psb_dasb.f90 b/base/tools/psb_dasb.f90 index 41592047..9f4589bd 100644 --- a/base/tools/psb_dasb.f90 +++ b/base/tools/psb_dasb.f90 @@ -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' diff --git a/base/tools/psb_iasb.f90 b/base/tools/psb_iasb.f90 index a83a15ca..b7d02bc0 100644 --- a/base/tools/psb_iasb.f90 +++ b/base/tools/psb_iasb.f90 @@ -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' diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index 000d9efb..746baf02 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -!!$ +! ! ! ! diff --git a/base/tools/psb_sasb.f90 b/base/tools/psb_sasb.f90 index 2eb4d250..a960d50f 100644 --- a/base/tools/psb_sasb.f90 +++ b/base/tools/psb_sasb.f90 @@ -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' diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 18f6d9e0..98d3246a 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -29,7 +29,7 @@ ! POSSIBILITY OF SUCH DAMAGE. ! ! -!!$ +! ! ! ! diff --git a/base/tools/psb_zasb.f90 b/base/tools/psb_zasb.f90 index 835f20ef..ee3cbc91 100644 --- a/base/tools/psb_zasb.f90 +++ b/base/tools/psb_zasb.f90 @@ -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'