fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
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.
psblas-3.0-maint
Salvatore Filippone 13 years ago
parent 22b30dcba3
commit f646aae2bc
12 changed files with 421 additions and 140 deletions
Show Stats Download Patch File Download Diff File

15
base/modules/psb_c_tools_mod.f90
Unescape Escape 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_, &

15
base/modules/psb_d_tools_mod.f90
Unescape Escape 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_, &

15
base/modules/psb_s_tools_mod.f90
Unescape Escape 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_, &

15
base/modules/psb_z_tools_mod.f90
Unescape Escape 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_, &

55
base/tools/psb_cins.f90
Unescape Escape 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
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
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
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,8 +570,17 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl)
call psb_errpush(info,name)
goto 9999
endif
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_)

29
base/tools/psb_cspins.f90
Unescape Escape 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)

83
base/tools/psb_dins.f90
Unescape Escape View File

@ -45,12 +45,13 @@
! 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
@ -58,16 +59,18 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, 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(:)
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
@ -115,7 +118,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
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_
@ -128,9 +130,17 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
else
dupl_ = psb_dupl_ovwrt_
endif
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
@ -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
@ -195,12 +206,14 @@ subroutine psb_dins_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_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
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
@ -305,12 +326,14 @@ subroutine psb_dins_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_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
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
@ -449,7 +483,7 @@ end subroutine psb_dins_vect_r2
! 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
@ -463,31 +497,32 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, 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(:,:)
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
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_)

29
base/tools/psb_dspins.f90
Unescape Escape 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)

83
base/tools/psb_sins.f90
Unescape Escape View File

@ -45,12 +45,13 @@
! 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
@ -58,16 +59,18 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
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(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
@ -115,7 +118,6 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
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_
@ -128,9 +130,17 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
else
dupl_ = psb_dupl_ovwrt_
endif
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
@ -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
@ -195,12 +206,14 @@ subroutine psb_sins_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_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
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
@ -305,12 +326,14 @@ subroutine psb_sins_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_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
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,7 +467,7 @@ 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.
@ -449,7 +483,7 @@ end subroutine psb_sins_vect_r2
! 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
@ -463,16 +497,18 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
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(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,8 +570,17 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
call psb_errpush(info,name)
goto 9999
endif
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_)

29
base/tools/psb_sspins.f90
Unescape Escape 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)

56
base/tools/psb_zins.f90
Unescape Escape 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
@ -128,9 +130,17 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
else
dupl_ = psb_dupl_ovwrt_
endif
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
@ -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
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
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,8 +570,17 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl)
call psb_errpush(info,name)
goto 9999
endif
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_)

29
base/tools/psb_zspins.f90
Unescape Escape 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)

Write Preview
Loading…
Cancel
Save