From f646aae2bc9bc326e2b3af34d112814a2b9647bd Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 13 Apr 2012 11:31:09 +0000 Subject: [PATCH] psblas3: base/modules/psb_c_tools_mod.f90 base/modules/psb_d_tools_mod.f90 base/modules/psb_s_tools_mod.f90 base/modules/psb_z_tools_mod.f90 base/tools/psb_cins.f90 base/tools/psb_cspins.f90 base/tools/psb_dins.f90 base/tools/psb_dspins.f90 base/tools/psb_sins.f90 base/tools/psb_sspins.f90 base/tools/psb_zins.f90 base/tools/psb_zspins.f90 Introduced LOCAL in spins/geins. --- base/modules/psb_c_tools_mod.f90 | 15 ++-- base/modules/psb_d_tools_mod.f90 | 15 ++-- base/modules/psb_s_tools_mod.f90 | 15 ++-- base/modules/psb_z_tools_mod.f90 | 15 ++-- base/tools/psb_cins.f90 | 65 +++++++++++++--- base/tools/psb_cspins.f90 | 29 +++++-- base/tools/psb_dins.f90 | 129 +++++++++++++++++++++---------- base/tools/psb_dspins.f90 | 29 +++++-- base/tools/psb_sins.f90 | 119 +++++++++++++++++++--------- base/tools/psb_sspins.f90 | 29 +++++-- base/tools/psb_zins.f90 | 72 +++++++++++++---- base/tools/psb_zspins.f90 | 29 +++++-- 12 files changed, 421 insertions(+), 140 deletions(-) diff --git a/base/modules/psb_c_tools_mod.f90 b/base/modules/psb_c_tools_mod.f90 index abf7d4a1..05d2b5ad 100644 --- a/base/modules/psb_c_tools_mod.f90 +++ b/base/modules/psb_c_tools_mod.f90 @@ -167,7 +167,7 @@ Module psb_c_tools_mod interface psb_geins - subroutine psb_cinsi(m,irw,val, x, desc_a,info,dupl) + subroutine psb_cinsi(m,irw,val, x, desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_c_base_vect_type, psb_c_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat @@ -178,8 +178,9 @@ Module psb_c_tools_mod complex(psb_spk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_cinsi - subroutine psb_cinsvi(m, irw,val, x,desc_a,info,dupl) + subroutine psb_cinsvi(m, irw,val, x,desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_c_base_vect_type, psb_c_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat @@ -190,8 +191,9 @@ Module psb_c_tools_mod complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_cinsvi - subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl) + subroutine psb_cins_vect(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_c_base_vect_type, psb_c_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat @@ -202,8 +204,9 @@ Module psb_c_tools_mod complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_cins_vect - subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl) + subroutine psb_cins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_c_base_vect_type, psb_c_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat @@ -214,6 +217,7 @@ Module psb_c_tools_mod complex(psb_spk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_cins_vect_r2 end interface @@ -270,7 +274,7 @@ Module psb_c_tools_mod interface psb_spins - subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) + subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_c_base_vect_type, psb_c_vect_type, & & psb_cspmat_type, psb_c_base_sparse_mat @@ -280,6 +284,7 @@ Module psb_c_tools_mod complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild + logical, intent(in), optional :: local end subroutine psb_cspins subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) import :: psb_desc_type, psb_spk_, psb_ipk_, & diff --git a/base/modules/psb_d_tools_mod.f90 b/base/modules/psb_d_tools_mod.f90 index 86faf95d..e8ce4bc0 100644 --- a/base/modules/psb_d_tools_mod.f90 +++ b/base/modules/psb_d_tools_mod.f90 @@ -167,7 +167,7 @@ Module psb_d_tools_mod interface psb_geins - subroutine psb_dinsi(m,irw,val, x, desc_a,info,dupl) + subroutine psb_dinsi(m,irw,val, x, desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_d_base_vect_type, psb_d_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat @@ -178,8 +178,9 @@ Module psb_d_tools_mod real(psb_dpk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_dinsi - subroutine psb_dinsvi(m, irw,val, x,desc_a,info,dupl) + subroutine psb_dinsvi(m, irw,val, x,desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_d_base_vect_type, psb_d_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat @@ -190,8 +191,9 @@ Module psb_d_tools_mod real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_dinsvi - subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl) + subroutine psb_dins_vect(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_d_base_vect_type, psb_d_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat @@ -202,8 +204,9 @@ Module psb_d_tools_mod real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_dins_vect - subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl) + subroutine psb_dins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_d_base_vect_type, psb_d_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat @@ -214,6 +217,7 @@ Module psb_d_tools_mod real(psb_dpk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_dins_vect_r2 end interface @@ -270,7 +274,7 @@ Module psb_d_tools_mod interface psb_spins - subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) + subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_d_base_vect_type, psb_d_vect_type, & & psb_dspmat_type, psb_d_base_sparse_mat @@ -280,6 +284,7 @@ Module psb_d_tools_mod real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild + logical, intent(in), optional :: local end subroutine psb_dspins subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) import :: psb_desc_type, psb_dpk_, psb_ipk_, & diff --git a/base/modules/psb_s_tools_mod.f90 b/base/modules/psb_s_tools_mod.f90 index 599ac14f..59d04bd8 100644 --- a/base/modules/psb_s_tools_mod.f90 +++ b/base/modules/psb_s_tools_mod.f90 @@ -167,7 +167,7 @@ Module psb_s_tools_mod interface psb_geins - subroutine psb_sinsi(m,irw,val, x, desc_a,info,dupl) + subroutine psb_sinsi(m,irw,val, x, desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_s_base_vect_type, psb_s_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat @@ -178,8 +178,9 @@ Module psb_s_tools_mod real(psb_spk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_sinsi - subroutine psb_sinsvi(m, irw,val, x,desc_a,info,dupl) + subroutine psb_sinsvi(m, irw,val, x,desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_s_base_vect_type, psb_s_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat @@ -190,8 +191,9 @@ Module psb_s_tools_mod real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_sinsvi - subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl) + subroutine psb_sins_vect(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_s_base_vect_type, psb_s_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat @@ -202,8 +204,9 @@ Module psb_s_tools_mod real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_sins_vect - subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl) + subroutine psb_sins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_s_base_vect_type, psb_s_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat @@ -214,6 +217,7 @@ Module psb_s_tools_mod real(psb_spk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_sins_vect_r2 end interface @@ -270,7 +274,7 @@ Module psb_s_tools_mod interface psb_spins - subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) + subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) import :: psb_desc_type, psb_spk_, psb_ipk_, & & psb_s_base_vect_type, psb_s_vect_type, & & psb_sspmat_type, psb_s_base_sparse_mat @@ -280,6 +284,7 @@ Module psb_s_tools_mod real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild + logical, intent(in), optional :: local end subroutine psb_sspins subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) import :: psb_desc_type, psb_spk_, psb_ipk_, & diff --git a/base/modules/psb_z_tools_mod.f90 b/base/modules/psb_z_tools_mod.f90 index 078e2927..37e320fd 100644 --- a/base/modules/psb_z_tools_mod.f90 +++ b/base/modules/psb_z_tools_mod.f90 @@ -167,7 +167,7 @@ Module psb_z_tools_mod interface psb_geins - subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl) + subroutine psb_zinsi(m,irw,val, x, desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_z_base_vect_type, psb_z_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat @@ -178,8 +178,9 @@ Module psb_z_tools_mod complex(psb_dpk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_zinsi - subroutine psb_zinsvi(m, irw,val, x,desc_a,info,dupl) + subroutine psb_zinsvi(m, irw,val, x,desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_z_base_vect_type, psb_z_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat @@ -190,8 +191,9 @@ Module psb_z_tools_mod complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_zinsvi - subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl) + subroutine psb_zins_vect(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_z_base_vect_type, psb_z_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat @@ -202,8 +204,9 @@ Module psb_z_tools_mod complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_zins_vect - subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl) + subroutine psb_zins_vect_r2(m,irw,val,x,desc_a,info,dupl,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_z_base_vect_type, psb_z_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat @@ -214,6 +217,7 @@ Module psb_z_tools_mod complex(psb_dpk_), intent(in) :: val(:,:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local end subroutine psb_zins_vect_r2 end interface @@ -270,7 +274,7 @@ Module psb_z_tools_mod interface psb_spins - subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) + subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) import :: psb_desc_type, psb_dpk_, psb_ipk_, & & psb_z_base_vect_type, psb_z_vect_type, & & psb_zspmat_type, psb_z_base_sparse_mat @@ -280,6 +284,7 @@ Module psb_z_tools_mod complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild + logical, intent(in), optional :: local end subroutine psb_zspins subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) import :: psb_desc_type, psb_dpk_, psb_ipk_, & diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 5139e704..c9027c34 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -45,7 +45,7 @@ ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_cinsvi use psi_mod implicit none @@ -63,12 +63,14 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -128,9 +130,17 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m @@ -179,7 +189,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_cinsvi -subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl) +subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_cins_vect use psi_mod implicit none @@ -196,12 +206,14 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -264,9 +276,17 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then call psb_errpush(info,name) @@ -289,7 +309,7 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl) end subroutine psb_cins_vect -subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl) +subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_cins_vect_r2 use psi_mod implicit none @@ -306,12 +326,14 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5), n integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -374,8 +396,18 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + do i=1,n if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) @@ -451,7 +483,7 @@ end subroutine psb_cins_vect_r2 ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_cinsi use psi_mod implicit none @@ -469,12 +501,14 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -536,9 +570,18 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl) call psb_errpush(info,name) goto 9999 endif - - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m diff --git a/base/tools/psb_cspins.f90 b/base/tools/psb_cspins.f90 index 58c6e526..3a6f2e48 100644 --- a/base/tools/psb_cspins.f90 +++ b/base/tools/psb_cspins.f90 @@ -48,7 +48,7 @@ ! rebuild - logical Allows to reopen a matrix under ! certain circumstances. ! -subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) +subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_cspins use psi_mod implicit none @@ -59,14 +59,14 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) complex(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: rebuild + logical, intent(in), optional :: rebuild, local !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: ictxt,np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 - logical :: rebuild_ + logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name @@ -113,8 +113,19 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) rebuild_ = .false. endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (psb_is_bld_desc(desc_a)) then + if (local_) then + info = psb_err_invalid_a_and_cd_state_ + call psb_errpush(info,name) + goto 9999 + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -145,10 +156,18 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name) goto 9999 end if + endif - else if (psb_is_asb_desc(desc_a)) then + if (local_) then + call a%csput(nz,ia,ja,val,ione,nrow,ione,ncol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='a%csput') + goto 9999 + end if + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -170,7 +189,7 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err='a%csput') goto 9999 end if - + end if else info = psb_err_invalid_cd_state_ call psb_errpush(info,name) diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index 9f1b879f..7f784889 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -38,36 +38,39 @@ ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. ! irw(:) - integer Row indices of rows of val (global numbering) -! val(:) - real The source dense submatrix. -! x(:) - real The destination dense matrix. +! val(:) - real The source dense submatrix. +! x(:) - real The destination dense matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_dinsvi use psi_mod implicit none ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix ! must be inserted !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_dpk_), intent(in) :: val(:) - real(psb_dpk_), intent(inout) :: x(:) + real(psb_dpk_), intent(in) :: val(:) + real(psb_dpk_),intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -81,7 +84,7 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt = desc_a%get_context() + ictxt=desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -110,27 +113,34 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - if (m == 0) return + if (m == 0) return loc_rows = desc_a%get_local_rows() loc_cols = desc_a%get_local_cols() mglob = desc_a%get_global_rows() - allocate(irl(m),stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) goto 9999 endif - + if (present(dupl)) then dupl_ = dupl else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m @@ -150,8 +160,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) !loop over all val's rows if (irl(i) > 0) then - ! this row belongs to me - ! copy i-th row of block val in x + ! this row belongs to me + ! copy i-th row of block val in x x(irl(i)) = x(irl(i)) + val(i) end if enddo @@ -178,7 +188,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_dinsvi -subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl) + +subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_dins_vect use psi_mod implicit none @@ -190,17 +201,19 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl) !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_dpk_), intent(in) :: val(:) + real(psb_dpk_), intent(in) :: val(:) type(psb_d_vect_type), intent(inout) :: x type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -263,9 +276,17 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then call psb_errpush(info,name) @@ -288,7 +309,7 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl) end subroutine psb_dins_vect -subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl) +subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_dins_vect_r2 use psi_mod implicit none @@ -300,17 +321,19 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl) !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_dpk_), intent(in) :: val(:,:) + real(psb_dpk_), intent(in) :: val(:,:) type(psb_d_vect_type), intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5), n integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -373,8 +396,18 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + do i=1,n if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) @@ -402,6 +435,7 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl) end subroutine psb_dins_vect_r2 + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 @@ -439,17 +473,17 @@ end subroutine psb_dins_vect_r2 ! Row indices not belonging to the current process are silently discarded. ! ! Arguments: -! m - integer. Number of rows of submatrix belonging to +! m - integer. Number of rows of submatrix belonging to ! val to be inserted. ! irw(:) - integer Row indices of rows of val (global numbering) -! val(:,:) - real The source dense submatrix. -! x(:,:) - real The destination dense matrix. +! val(:,:) - real The source dense submatrix. +! x(:,:) - real The destination dense matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_dinsi use psi_mod implicit none @@ -460,34 +494,35 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) ! must be inserted !....parameters... - integer(psb_ipk_), intent(in) :: m - integer(psb_ipk_), intent(in) :: irw(:) - real(psb_dpk_), intent(in) :: val(:,:) - real(psb_dpk_), intent(inout) :: x(:,:) - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_), optional, intent(in) :: dupl + integer(psb_ipk_), intent(in) :: m + integer(psb_ipk_), intent(in) :: irw(:) + real(psb_dpk_), intent(in) :: val(:,:) + real(psb_dpk_),intent(inout) :: x(:,:) + type(psb_desc_type), intent(in) :: desc_a + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name + if(psb_get_errstatus() /= 0) return info=psb_success_ - if (psb_errstatus_fatal()) return call psb_erractionsave(err_act) name = 'psb_dinsi' - if (.not.desc_a%is_ok()) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 + if (.not.psb_is_ok_desc(desc_a)) then + int_err(1)=3110 + call psb_errpush(info,name) + return end if - ictxt = desc_a%get_context() + ictxt=desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -503,6 +538,11 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 + else if (.not.psb_is_ok_desc(desc_a)) then + info = psb_err_input_matrix_unassembled_ + int_err(1) = desc_a%get_dectype() + call psb_errpush(info,name,int_err) + goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -530,8 +570,17 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl) call psb_errpush(info,name) goto 9999 endif - - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (present(local)) then + local_ = local + else + local_ = .false. + endif + + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if select case(dupl_) case(psb_dupl_ovwrt_) diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 6bf819e9..cebe90de 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -48,7 +48,7 @@ ! rebuild - logical Allows to reopen a matrix under ! certain circumstances. ! -subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) +subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_dspins use psi_mod implicit none @@ -59,14 +59,14 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) real(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: rebuild + logical, intent(in), optional :: rebuild, local !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: ictxt,np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 - logical :: rebuild_ + logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name @@ -113,8 +113,19 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) rebuild_ = .false. endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (psb_is_bld_desc(desc_a)) then + if (local_) then + info = psb_err_invalid_a_and_cd_state_ + call psb_errpush(info,name) + goto 9999 + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -145,10 +156,18 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name) goto 9999 end if + endif - else if (psb_is_asb_desc(desc_a)) then + if (local_) then + call a%csput(nz,ia,ja,val,ione,nrow,ione,ncol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='a%csput') + goto 9999 + end if + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -170,7 +189,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err='a%csput') goto 9999 end if - + end if else info = psb_err_invalid_cd_state_ call psb_errpush(info,name) diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 79d4fdc1..ce503d87 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -38,36 +38,39 @@ ! m - integer. Number of rows of submatrix belonging to ! val to be inserted. ! irw(:) - integer Row indices of rows of val (global numbering) -! val(:) - real The source dense submatrix. -! x(:) - real The destination dense matrix. +! val(:) - real The source dense submatrix. +! x(:) - real The destination dense matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_sinsvi use psi_mod implicit none ! m rows number of submatrix belonging to val to be inserted + ! ix x global-row corresponding to position at which val submatrix ! must be inserted !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_spk_), intent(in) :: val(:) - real(psb_spk_), intent(inout) :: x(:) + real(psb_spk_), intent(in) :: val(:) + real(psb_spk_),intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -81,7 +84,7 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) return end if - ictxt = desc_a%get_context() + ictxt=desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -110,27 +113,34 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) goto 9999 endif - if (m == 0) return + if (m == 0) return loc_rows = desc_a%get_local_rows() loc_cols = desc_a%get_local_cols() mglob = desc_a%get_global_rows() - allocate(irl(m),stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) goto 9999 endif - + if (present(dupl)) then dupl_ = dupl else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m @@ -150,8 +160,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) !loop over all val's rows if (irl(i) > 0) then - ! this row belongs to me - ! copy i-th row of block val in x + ! this row belongs to me + ! copy i-th row of block val in x x(irl(i)) = x(irl(i)) + val(i) end if enddo @@ -178,7 +188,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_sinsvi -subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl) + +subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_sins_vect use psi_mod implicit none @@ -190,17 +201,19 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl) !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_spk_), intent(in) :: val(:) + real(psb_spk_), intent(in) :: val(:) type(psb_s_vect_type), intent(inout) :: x type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -263,9 +276,17 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then call psb_errpush(info,name) @@ -288,7 +309,7 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl) end subroutine psb_sins_vect -subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl) +subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_sins_vect_r2 use psi_mod implicit none @@ -300,17 +321,19 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl) !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_spk_), intent(in) :: val(:,:) + real(psb_spk_), intent(in) :: val(:,:) type(psb_s_vect_type), intent(inout) :: x(:) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5), n integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -373,8 +396,18 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + do i=1,n if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) @@ -402,6 +435,7 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl) end subroutine psb_sins_vect_r2 + !!$ !!$ Parallel Sparse BLAS version 3.0 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 @@ -433,23 +467,23 @@ end subroutine psb_sins_vect_r2 !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -! Subroutine: psb_dinsi +! Subroutine: psb_sinsi ! Insert dense submatrix to dense matrix. Note: the row indices in IRW ! are assumed to be in global numbering and are converted on the fly. ! Row indices not belonging to the current process are silently discarded. ! ! Arguments: -! m - integer. Number of rows of submatrix belonging to +! m - integer. Number of rows of submatrix belonging to ! val to be inserted. ! irw(:) - integer Row indices of rows of val (global numbering) -! val(:,:) - real The source dense submatrix. -! x(:,:) - real The destination dense matrix. +! val(:,:) - real The source dense submatrix. +! x(:,:) - real The destination dense matrix. ! desc_a - type(psb_desc_type). The communication descriptor. ! info - integer. return code ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_sinsi use psi_mod implicit none @@ -462,17 +496,19 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) !....parameters... integer(psb_ipk_), intent(in) :: m integer(psb_ipk_), intent(in) :: irw(:) - real(psb_spk_), intent(in) :: val(:,:) - real(psb_spk_), intent(inout) :: x(:,:) + real(psb_spk_), intent(in) :: val(:,:) + real(psb_spk_),intent(inout) :: x(:,:) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -480,14 +516,13 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) call psb_erractionsave(err_act) name = 'psb_sinsi' - if (.not.desc_a%is_ok()) then - info = psb_err_input_matrix_unassembled_ - int_err(1) = desc_a%get_dectype() - call psb_errpush(info,name,int_err) - goto 9999 + if (.not.psb_is_ok_desc(desc_a)) then + int_err(1)=3110 + call psb_errpush(info,name) + return end if - ictxt = desc_a%get_context() + ictxt=desc_a%get_context() call psb_info(ictxt, me, np) if (np == -1) then @@ -503,6 +538,11 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) int_err(2) = m call psb_errpush(info,name,int_err) goto 9999 + else if (.not.psb_is_ok_desc(desc_a)) then + info = psb_err_input_matrix_unassembled_ + int_err(1) = desc_a%get_dectype() + call psb_errpush(info,name,int_err) + goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 int_err(1) = 5 @@ -530,9 +570,18 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl) call psb_errpush(info,name) goto 9999 endif - - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m diff --git a/base/tools/psb_sspins.f90 b/base/tools/psb_sspins.f90 index 1bd8330f..761c6595 100644 --- a/base/tools/psb_sspins.f90 +++ b/base/tools/psb_sspins.f90 @@ -48,7 +48,7 @@ ! rebuild - logical Allows to reopen a matrix under ! certain circumstances. ! -subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) +subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_sspins use psi_mod implicit none @@ -59,14 +59,14 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) real(psb_spk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: rebuild + logical, intent(in), optional :: rebuild, local !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: ictxt,np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 - logical :: rebuild_ + logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name @@ -113,8 +113,19 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) rebuild_ = .false. endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (psb_is_bld_desc(desc_a)) then + if (local_) then + info = psb_err_invalid_a_and_cd_state_ + call psb_errpush(info,name) + goto 9999 + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -145,10 +156,18 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name) goto 9999 end if + endif - else if (psb_is_asb_desc(desc_a)) then + if (local_) then + call a%csput(nz,ia,ja,val,ione,nrow,ione,ncol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='a%csput') + goto 9999 + end if + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -170,7 +189,7 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err='a%csput') goto 9999 end if - + end if else info = psb_err_invalid_cd_state_ call psb_errpush(info,name) diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 610a1d63..53014dd9 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -45,7 +45,7 @@ ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_zinsvi use psi_mod implicit none @@ -63,12 +63,14 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -122,15 +124,23 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) call psb_errpush(info,name) goto 9999 endif - + if (present(dupl)) then dupl_ = dupl else dupl_ = psb_dupl_ovwrt_ endif - - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m @@ -150,8 +160,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) !loop over all val's rows if (irl(i) > 0) then - ! this row belongs to me - ! copy i-th row of block val in x + ! this row belongs to me + ! copy i-th row of block val in x x(irl(i)) = x(irl(i)) + val(i) end if enddo @@ -178,7 +188,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl) end subroutine psb_zinsvi -subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl) + +subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_zins_vect use psi_mod implicit none @@ -195,12 +206,14 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -263,9 +276,17 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) - + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if call x%ins(m,irl,val,dupl_,info) if (info /= 0) then call psb_errpush(info,name) @@ -288,7 +309,7 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl) end subroutine psb_zins_vect -subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl) +subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_zins_vect_r2 use psi_mod implicit none @@ -305,12 +326,14 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,& & loc_rows,loc_cols,mglob,err_act, int_err(5), n integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if (psb_errstatus_fatal()) return @@ -373,8 +396,18 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl) else dupl_ = psb_dupl_ovwrt_ endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + do i=1,n if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ if (info == 0) call x(i)%ins(m,irl,val(:,i),dupl_,info) @@ -450,7 +483,7 @@ end subroutine psb_zins_vect_r2 ! dupl - integer What to do with duplicates: ! psb_dupl_ovwrt_ overwrite ! psb_dupl_add_ add -subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl) +subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) use psb_base_mod, psb_protect_name => psb_zinsi use psi_mod implicit none @@ -468,12 +501,14 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl) type(psb_desc_type), intent(in) :: desc_a integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(in) :: dupl + logical, intent(in), optional :: local !locals..... integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& & loc_rows,loc_cols,mglob,err_act, int_err(5) integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) + logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -535,9 +570,18 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl) call psb_errpush(info,name) goto 9999 endif - - call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (local_) then + irl(1:m) = irw(1:m) + else + call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.) + end if + select case(dupl_) case(psb_dupl_ovwrt_) do i = 1, m diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 index 9b022850..747b62a7 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.f90 @@ -48,7 +48,7 @@ ! rebuild - logical Allows to reopen a matrix under ! certain circumstances. ! -subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) +subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_zspins use psi_mod implicit none @@ -59,14 +59,14 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) complex(psb_dpk_), intent(in) :: val(:) integer(psb_ipk_), intent(out) :: info - logical, intent(in), optional :: rebuild + logical, intent(in), optional :: rebuild, local !locals..... integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: ictxt,np,me logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 - logical :: rebuild_ + logical :: rebuild_, local_ integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_) :: ierr(5) character(len=20) :: name @@ -113,8 +113,19 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) rebuild_ = .false. endif + if (present(local)) then + local_ = local + else + local_ = .false. + endif + if (psb_is_bld_desc(desc_a)) then + if (local_) then + info = psb_err_invalid_a_and_cd_state_ + call psb_errpush(info,name) + goto 9999 + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -145,10 +156,18 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name) goto 9999 end if + endif - else if (psb_is_asb_desc(desc_a)) then + if (local_) then + call a%csput(nz,ia,ja,val,ione,nrow,ione,ncol,info) + if (info /= psb_success_) then + info=psb_err_from_subroutine_ + call psb_errpush(info,name,a_err='a%csput') + goto 9999 + end if + else allocate(ila(nz),jla(nz),stat=info) if (info /= psb_success_) then ierr(1) = info @@ -170,7 +189,7 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) call psb_errpush(info,name,a_err='a%csput') goto 9999 end if - + end if else info = psb_err_invalid_cd_state_ call psb_errpush(info,name)