fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-17 11:22:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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.
This commit is contained in:
Salvatore Filippone
2012-04-13 11:31:09 +00:00
parent 22b30dcba3
commit f646aae2bc
12 changed files with 421 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_c_tools_mod.f90
+10 -5
View File
@@ -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_, &
base/modules/psb_d_tools_mod.f90
+10 -5
View File
@@ -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_, &
base/modules/psb_s_tools_mod.f90
+10 -5
View File
@@ -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_, &
base/modules/psb_z_tools_mod.f90
+10 -5
View File
@@ -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_, &
base/tools/psb_cins.f90
+54 -11
View File
@@ -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
base/tools/psb_cspins.f90
+24 -5
View File
@@ -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)
base/tools/psb_dins.f90
+89 -40
View File
@@ -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_)
base/tools/psb_dspins.f90
+24 -5
View File
@@ -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)
base/tools/psb_sins.f90
+84 -35
View File
@@ -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
base/tools/psb_sspins.f90
+24 -5
View File
@@ -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)
base/tools/psb_zins.f90
+58 -14
View File
@@ -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
base/tools/psb_zspins.f90
+24 -5
View File
@@ -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)