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 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_base_vect_type, psb_c_vect_type, & & psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat & psb_cspmat_type, psb_c_base_sparse_mat
@ -178,8 +178,9 @@ Module psb_c_tools_mod
complex(psb_spk_), intent(in) :: val(:,:) complex(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cinsi 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_base_vect_type, psb_c_vect_type, & & psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat & psb_cspmat_type, psb_c_base_sparse_mat
@ -190,8 +191,9 @@ Module psb_c_tools_mod
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cinsvi 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_base_vect_type, psb_c_vect_type, & & psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat & psb_cspmat_type, psb_c_base_sparse_mat
@ -202,8 +204,9 @@ Module psb_c_tools_mod
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cins_vect 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_base_vect_type, psb_c_vect_type, & & psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat & psb_cspmat_type, psb_c_base_sparse_mat
@ -214,6 +217,7 @@ Module psb_c_tools_mod
complex(psb_spk_), intent(in) :: val(:,:) complex(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_cins_vect_r2 end subroutine psb_cins_vect_r2
end interface end interface
@ -270,7 +274,7 @@ Module psb_c_tools_mod
interface psb_spins 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_c_base_vect_type, psb_c_vect_type, & & psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat & psb_cspmat_type, psb_c_base_sparse_mat
@ -280,6 +284,7 @@ Module psb_c_tools_mod
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild
logical, intent(in), optional :: local
end subroutine psb_cspins end subroutine psb_cspins
subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & 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 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, & & psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat & psb_dspmat_type, psb_d_base_sparse_mat
@ -178,8 +178,9 @@ Module psb_d_tools_mod
real(psb_dpk_), intent(in) :: val(:,:) real(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dinsi 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, & & psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat & psb_dspmat_type, psb_d_base_sparse_mat
@ -190,8 +191,9 @@ Module psb_d_tools_mod
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dinsvi 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, & & psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat & psb_dspmat_type, psb_d_base_sparse_mat
@ -202,8 +204,9 @@ Module psb_d_tools_mod
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, & & psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat & psb_dspmat_type, psb_d_base_sparse_mat
@ -214,6 +217,7 @@ Module psb_d_tools_mod
real(psb_dpk_), intent(in) :: val(:,:) real(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_dins_vect_r2 end subroutine psb_dins_vect_r2
end interface end interface
@ -270,7 +274,7 @@ Module psb_d_tools_mod
interface psb_spins 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_d_base_vect_type, psb_d_vect_type, & & psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat & psb_dspmat_type, psb_d_base_sparse_mat
@ -280,6 +284,7 @@ Module psb_d_tools_mod
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild
logical, intent(in), optional :: local
end subroutine psb_dspins end subroutine psb_dspins
subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & 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 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_base_vect_type, psb_s_vect_type, & & psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat & psb_sspmat_type, psb_s_base_sparse_mat
@ -178,8 +178,9 @@ Module psb_s_tools_mod
real(psb_spk_), intent(in) :: val(:,:) real(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sinsi 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_base_vect_type, psb_s_vect_type, & & psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat & psb_sspmat_type, psb_s_base_sparse_mat
@ -190,8 +191,9 @@ Module psb_s_tools_mod
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sinsvi 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_base_vect_type, psb_s_vect_type, & & psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat & psb_sspmat_type, psb_s_base_sparse_mat
@ -202,8 +204,9 @@ Module psb_s_tools_mod
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sins_vect 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_base_vect_type, psb_s_vect_type, & & psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat & psb_sspmat_type, psb_s_base_sparse_mat
@ -214,6 +217,7 @@ Module psb_s_tools_mod
real(psb_spk_), intent(in) :: val(:,:) real(psb_spk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_sins_vect_r2 end subroutine psb_sins_vect_r2
end interface end interface
@ -270,7 +274,7 @@ Module psb_s_tools_mod
interface psb_spins 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_, & import :: psb_desc_type, psb_spk_, psb_ipk_, &
& psb_s_base_vect_type, psb_s_vect_type, & & psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat & psb_sspmat_type, psb_s_base_sparse_mat
@ -280,6 +284,7 @@ Module psb_s_tools_mod
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild
logical, intent(in), optional :: local
end subroutine psb_sspins end subroutine psb_sspins
subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_spk_, psb_ipk_, & 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 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_base_vect_type, psb_z_vect_type, & & psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat & psb_zspmat_type, psb_z_base_sparse_mat
@ -178,8 +178,9 @@ Module psb_z_tools_mod
complex(psb_dpk_), intent(in) :: val(:,:) complex(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zinsi 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_base_vect_type, psb_z_vect_type, & & psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat & psb_zspmat_type, psb_z_base_sparse_mat
@ -190,8 +191,9 @@ Module psb_z_tools_mod
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zinsvi 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_base_vect_type, psb_z_vect_type, & & psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat & psb_zspmat_type, psb_z_base_sparse_mat
@ -202,8 +204,9 @@ Module psb_z_tools_mod
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zins_vect 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_base_vect_type, psb_z_vect_type, & & psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat & psb_zspmat_type, psb_z_base_sparse_mat
@ -214,6 +217,7 @@ Module psb_z_tools_mod
complex(psb_dpk_), intent(in) :: val(:,:) complex(psb_dpk_), intent(in) :: val(:,:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
end subroutine psb_zins_vect_r2 end subroutine psb_zins_vect_r2
end interface end interface
@ -270,7 +274,7 @@ Module psb_z_tools_mod
interface psb_spins 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_, & import :: psb_desc_type, psb_dpk_, psb_ipk_, &
& psb_z_base_vect_type, psb_z_vect_type, & & psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat & psb_zspmat_type, psb_z_base_sparse_mat
@ -280,6 +284,7 @@ Module psb_z_tools_mod
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild
logical, intent(in), optional :: local
end subroutine psb_zspins end subroutine psb_zspins
subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info)
import :: psb_desc_type, psb_dpk_, psb_ipk_, & 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: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_cinsvi
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
@ -128,9 +130,17 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, m do i = 1, m
@ -179,7 +189,7 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl)
end subroutine psb_cinsvi 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 psb_base_mod, psb_protect_name => psb_cins_vect
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -264,9 +276,17 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
call x%ins(m,irl,val,dupl_,info) call x%ins(m,irl,val,dupl_,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(info,name) 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 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 psb_base_mod, psb_protect_name => psb_cins_vect_r2
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5), n & loc_rows,loc_cols,mglob,err_act, int_err(5), n
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -374,8 +396,18 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
do i=1,n do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ 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) 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: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_cinsi
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: ictxt,i,loc_row,j,n,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_) :: np,me,dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return 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) call psb_errpush(info,name)
goto 9999 goto 9999
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) 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 ! rebuild - logical Allows to reopen a matrix under
! certain circumstances. ! 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 psb_base_mod, psb_protect_name => psb_cspins
use psi_mod use psi_mod
implicit none 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(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
complex(psb_spk_), intent(in) :: val(:) complex(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild, local
!locals..... !locals.....
integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: nrow, err_act, ncol, spstate
integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: ictxt,np,me
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -113,8 +113,19 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false. rebuild_ = .false.
endif endif
if (present(local)) then
local_ = local
else
local_ = .false.
endif
if (psb_is_bld_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info ierr(1) = info
@ -145,10 +156,18 @@ subroutine psb_cspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
endif
else if (psb_is_asb_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info 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') call psb_errpush(info,name,a_err='a%csput')
goto 9999 goto 9999
end if end if
end if
else else
info = psb_err_invalid_cd_state_ info = psb_err_invalid_cd_state_
call psb_errpush(info,name) call psb_errpush(info,name)

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

@ -45,12 +45,13 @@
! dupl - integer What to do with duplicates: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_dinsvi
use psi_mod use psi_mod
implicit none implicit none
! m rows number of submatrix belonging to val to be inserted ! m rows number of submatrix belonging to val to be inserted
! ix x global-row corresponding to position at which val submatrix ! ix x global-row corresponding to position at which val submatrix
! must be inserted ! must be inserted
@ -62,12 +63,14 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
@ -115,7 +118,6 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
loc_cols = desc_a%get_local_cols() loc_cols = desc_a%get_local_cols()
mglob = desc_a%get_global_rows() mglob = desc_a%get_global_rows()
allocate(irl(m),stat=info) allocate(irl(m),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
@ -128,9 +130,17 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, m do i = 1, m
@ -178,7 +188,8 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl)
end subroutine psb_dinsvi 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 psb_base_mod, psb_protect_name => psb_dins_vect
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -263,9 +276,17 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
call x%ins(m,irl,val,dupl_,info) call x%ins(m,irl,val,dupl_,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(info,name) 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 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 psb_base_mod, psb_protect_name => psb_dins_vect_r2
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5), n & loc_rows,loc_cols,mglob,err_act, int_err(5), n
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -373,8 +396,18 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
do i=1,n do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ 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) 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 end subroutine psb_dins_vect_r2
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
@ -449,7 +483,7 @@ end subroutine psb_dins_vect_r2
! dupl - integer What to do with duplicates: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_dinsi
use psi_mod use psi_mod
implicit none implicit none
@ -467,24 +501,25 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: ictxt,i,loc_row,j,n,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_) :: np,me,dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
if (psb_errstatus_fatal()) return
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_dinsi' name = 'psb_dinsi'
if (.not.desc_a%is_ok()) then if (.not.psb_is_ok_desc(desc_a)) then
info = psb_err_input_matrix_unassembled_ int_err(1)=3110
int_err(1) = desc_a%get_dectype() call psb_errpush(info,name)
call psb_errpush(info,name,int_err) return
goto 9999
end if end if
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
@ -503,6 +538,11 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
int_err(2) = m int_err(2) = m
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 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 else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 int_err(1) = 5
@ -530,8 +570,17 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) 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 ! rebuild - logical Allows to reopen a matrix under
! certain circumstances. ! 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 psb_base_mod, psb_protect_name => psb_dspins
use psi_mod use psi_mod
implicit none 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(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
real(psb_dpk_), intent(in) :: val(:) real(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild, local
!locals..... !locals.....
integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: nrow, err_act, ncol, spstate
integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: ictxt,np,me
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -113,8 +113,19 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false. rebuild_ = .false.
endif endif
if (present(local)) then
local_ = local
else
local_ = .false.
endif
if (psb_is_bld_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info ierr(1) = info
@ -145,10 +156,18 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
endif
else if (psb_is_asb_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info 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') call psb_errpush(info,name,a_err='a%csput')
goto 9999 goto 9999
end if end if
end if
else else
info = psb_err_invalid_cd_state_ info = psb_err_invalid_cd_state_
call psb_errpush(info,name) call psb_errpush(info,name)

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

@ -45,12 +45,13 @@
! dupl - integer What to do with duplicates: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_sinsvi
use psi_mod use psi_mod
implicit none implicit none
! m rows number of submatrix belonging to val to be inserted ! m rows number of submatrix belonging to val to be inserted
! ix x global-row corresponding to position at which val submatrix ! ix x global-row corresponding to position at which val submatrix
! must be inserted ! must be inserted
@ -62,12 +63,14 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
@ -115,7 +118,6 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
loc_cols = desc_a%get_local_cols() loc_cols = desc_a%get_local_cols()
mglob = desc_a%get_global_rows() mglob = desc_a%get_global_rows()
allocate(irl(m),stat=info) allocate(irl(m),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
@ -128,9 +130,17 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, m do i = 1, m
@ -178,7 +188,8 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl)
end subroutine psb_sinsvi 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 psb_base_mod, psb_protect_name => psb_sins_vect
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -263,9 +276,17 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
call x%ins(m,irl,val,dupl_,info) call x%ins(m,irl,val,dupl_,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(info,name) 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 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 psb_base_mod, psb_protect_name => psb_sins_vect_r2
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5), n & loc_rows,loc_cols,mglob,err_act, int_err(5), n
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -373,8 +396,18 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
do i=1,n do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ 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) 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 end subroutine psb_sins_vect_r2
!!$ !!$
!!$ Parallel Sparse BLAS version 3.0 !!$ Parallel Sparse BLAS version 3.0
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010 !!$ (C) Copyright 2006, 2007, 2008, 2009, 2010
@ -433,7 +467,7 @@ end subroutine psb_sins_vect_r2
!!$ POSSIBILITY OF SUCH DAMAGE. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
! Subroutine: psb_dinsi ! Subroutine: psb_sinsi
! Insert dense submatrix to dense matrix. Note: the row indices in IRW ! 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. ! are assumed to be in global numbering and are converted on the fly.
! Row indices not belonging to the current process are silently discarded. ! 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: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_sinsi
use psi_mod use psi_mod
implicit none implicit none
@ -467,12 +501,14 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
type(psb_desc_type), intent(in) :: desc_a type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: ictxt,i,loc_row,j,n,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_) :: np,me,dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
@ -480,11 +516,10 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_sinsi' name = 'psb_sinsi'
if (.not.desc_a%is_ok()) then if (.not.psb_is_ok_desc(desc_a)) then
info = psb_err_input_matrix_unassembled_ int_err(1)=3110
int_err(1) = desc_a%get_dectype() call psb_errpush(info,name)
call psb_errpush(info,name,int_err) return
goto 9999
end if end if
ictxt=desc_a%get_context() ictxt=desc_a%get_context()
@ -503,6 +538,11 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
int_err(2) = m int_err(2) = m
call psb_errpush(info,name,int_err) call psb_errpush(info,name,int_err)
goto 9999 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 else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 int_err(1) = 5
@ -530,8 +570,17 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) 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 ! rebuild - logical Allows to reopen a matrix under
! certain circumstances. ! 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 psb_base_mod, psb_protect_name => psb_sspins
use psi_mod use psi_mod
implicit none 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(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
real(psb_spk_), intent(in) :: val(:) real(psb_spk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild, local
!locals..... !locals.....
integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: nrow, err_act, ncol, spstate
integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: ictxt,np,me
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -113,8 +113,19 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false. rebuild_ = .false.
endif endif
if (present(local)) then
local_ = local
else
local_ = .false.
endif
if (psb_is_bld_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info ierr(1) = info
@ -145,10 +156,18 @@ subroutine psb_sspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
endif
else if (psb_is_asb_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info 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') call psb_errpush(info,name,a_err='a%csput')
goto 9999 goto 9999
end if end if
end if
else else
info = psb_err_invalid_cd_state_ info = psb_err_invalid_cd_state_
call psb_errpush(info,name) 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: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_zinsvi
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
@ -128,9 +130,17 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) case(psb_dupl_ovwrt_)
do i = 1, m do i = 1, m
@ -178,7 +188,8 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl)
end subroutine psb_zinsvi 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 psb_base_mod, psb_protect_name => psb_zins_vect
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -263,9 +276,17 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
call x%ins(m,irl,val,dupl_,info) call x%ins(m,irl,val,dupl_,info)
if (info /= 0) then if (info /= 0) then
call psb_errpush(info,name) 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 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 psb_base_mod, psb_protect_name => psb_zins_vect_r2
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: ictxt,i,&
& loc_rows,loc_cols,mglob,err_act, int_err(5), n & loc_rows,loc_cols,mglob,err_act, int_err(5), n
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: np, me, dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if (psb_errstatus_fatal()) return if (psb_errstatus_fatal()) return
@ -373,8 +396,18 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl)
else else
dupl_ = psb_dupl_ovwrt_ dupl_ = psb_dupl_ovwrt_
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
do i=1,n do i=1,n
if (.not.allocated(x(i)%v)) info = psb_err_invalid_vect_state_ 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) 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: ! dupl - integer What to do with duplicates:
! psb_dupl_ovwrt_ overwrite ! psb_dupl_ovwrt_ overwrite
! psb_dupl_add_ add ! 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 psb_base_mod, psb_protect_name => psb_zinsi
use psi_mod use psi_mod
implicit none 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 type(psb_desc_type), intent(in) :: desc_a
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), optional, intent(in) :: dupl integer(psb_ipk_), optional, intent(in) :: dupl
logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: ictxt,i,loc_row,j,n,&
& loc_rows,loc_cols,mglob,err_act, int_err(5) & loc_rows,loc_cols,mglob,err_act, int_err(5)
integer(psb_ipk_) :: np,me,dupl_ integer(psb_ipk_) :: np,me,dupl_
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return 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) call psb_errpush(info,name)
goto 9999 goto 9999
endif 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.) call psi_idx_cnv(m,irw,irl,desc_a,info,owned=.true.)
end if
select case(dupl_) select case(dupl_)
case(psb_dupl_ovwrt_) 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 ! rebuild - logical Allows to reopen a matrix under
! certain circumstances. ! 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 psb_base_mod, psb_protect_name => psb_zspins
use psi_mod use psi_mod
implicit none 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(:) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:)
complex(psb_dpk_), intent(in) :: val(:) complex(psb_dpk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: rebuild logical, intent(in), optional :: rebuild, local
!locals..... !locals.....
integer(psb_ipk_) :: nrow, err_act, ncol, spstate integer(psb_ipk_) :: nrow, err_act, ncol, spstate
integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: ictxt,np,me
logical, parameter :: debug=.false. logical, parameter :: debug=.false.
integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), parameter :: relocsz=200
logical :: rebuild_ logical :: rebuild_, local_
integer(psb_ipk_), allocatable :: ila(:),jla(:) integer(psb_ipk_), allocatable :: ila(:),jla(:)
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -113,8 +113,19 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
rebuild_ = .false. rebuild_ = .false.
endif endif
if (present(local)) then
local_ = local
else
local_ = .false.
endif
if (psb_is_bld_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info ierr(1) = info
@ -145,10 +156,18 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild)
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
endif
else if (psb_is_asb_desc(desc_a)) then 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) allocate(ila(nz),jla(nz),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
ierr(1) = info 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') call psb_errpush(info,name,a_err='a%csput')
goto 9999 goto 9999
end if end if
end if
else else
info = psb_err_invalid_cd_state_ info = psb_err_invalid_cd_state_
call psb_errpush(info,name) call psb_errpush(info,name)

Write Preview
Loading…
Cancel
Save