fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-24 23:01:48 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
Changelog
 base/comm/psb_cspgather.F90
 base/comm/psb_dspgather.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zspgather.F90
 base/internals/psi_bld_tmphalo.f90
 base/internals/psi_cswapdata.F90
 base/internals/psi_desc_impl.f90
 base/internals/psi_dswapdata.F90
 base/internals/psi_sswapdata.F90
 base/internals/psi_zswapdata.F90
 base/modules/Makefile
 base/modules/psb_c_base_vect_mod.f90
 base/modules/psb_c_linmap_mod.f90
 base/modules/psb_c_tools_mod.f90
 base/modules/psb_c_vect_mod.F90
 base/modules/psb_cd_tools_mod.f90
 base/modules/psb_d_base_vect_mod.f90
 base/modules/psb_d_linmap_mod.f90
 base/modules/psb_d_tools_mod.f90
 base/modules/psb_d_vect_mod.F90
 base/modules/psb_desc_mod.F90
 base/modules/psb_i_base_vect_mod.f90
 base/modules/psb_i_vect_mod.F90
 base/modules/psb_s_base_vect_mod.f90
 base/modules/psb_s_linmap_mod.f90
 base/modules/psb_s_tools_mod.f90
 base/modules/psb_s_vect_mod.F90
 base/modules/psb_z_base_vect_mod.f90
 base/modules/psb_z_linmap_mod.f90
 base/modules/psb_z_tools_mod.f90
 base/modules/psb_z_vect_mod.F90
 base/modules/psi_c_mod.f90
 base/modules/psi_d_mod.f90
 base/modules/psi_i_mod.f90
 base/modules/psi_s_mod.f90
 base/modules/psi_z_mod.f90
 base/tools/psb_c_map.f90
 base/tools/psb_ccdbldext.F90
 base/tools/psb_cd_lstext.f90
 base/tools/psb_cdcpy.F90
 base/tools/psb_csphalo.F90
 base/tools/psb_d_map.f90
 base/tools/psb_dcdbldext.F90
 base/tools/psb_dsphalo.F90
 base/tools/psb_icdasb.F90
 base/tools/psb_iins.f90
 base/tools/psb_s_map.f90
 base/tools/psb_scdbldext.F90
 base/tools/psb_ssphalo.F90
 base/tools/psb_z_map.f90
 base/tools/psb_zcdbldext.F90
 base/tools/psb_zsphalo.F90
 config/pac.m4
 configure.ac
 configure
 test/pargen/Makefile
 util/Makefile
 util/metis_int.c
 util/psb_d_genpde_impl.f90
 util/psb_d_genpde_mod.f90
 util/psb_metispart_mod.F90
 util/psb_s_genpde_impl.f90
 util/psb_s_genpde_mod.f90

Merged changes from 399 branch.
This commit is contained in:
Salvatore Filippone
2013-11-07 16:27:46 +00:00
parent 658b28b6f8 41c6bfc15e
commit 00d3701493
64 changed files with 3122 additions and 488 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/Makefile
+3 -2
View File
@@ -61,9 +61,10 @@ psb_ip_reord_mod.o psi_serial_mod.o psb_sort_mod.o: $(BASIC_MODS)
psb_base_mat_mod.o: psi_serial_mod.o
psb_s_base_mat_mod.o psb_d_base_mat_mod.o psb_c_base_mat_mod.o psb_z_base_mat_mod.o: psb_base_mat_mod.o
psb_s_base_mat_mod.o: psb_s_base_vect_mod.o
psb_d_base_mat_mod.o: psb_d_base_vect_mod.o
psb_d_base_mat_mod.o: psb_d_base_vect_mod.o
psb_c_base_mat_mod.o: psb_c_base_vect_mod.o
psb_z_base_mat_mod.o: psb_z_base_vect_mod.o
psb_c_base_vect_mod.o psb_s_base_vect_mod.o psb_d_base_vect_mod.o psb_z_base_vect_mod.o: psb_i_base_vect_mod.o
psb_i_base_vect_mod.o psb_c_base_vect_mod.o psb_s_base_vect_mod.o psb_d_base_vect_mod.o psb_z_base_vect_mod.o: psi_serial_mod.o psb_realloc_mod.o
psb_s_mat_mod.o: psb_s_base_mat_mod.o psb_s_csr_mat_mod.o psb_s_csc_mat_mod.o psb_s_vect_mod.o
psb_d_mat_mod.o: psb_d_base_mat_mod.o psb_d_csr_mat_mod.o psb_d_csc_mat_mod.o psb_d_vect_mod.o
@@ -87,7 +88,7 @@ psi_mod.o: psb_penv_mod.o psb_desc_mod.o psi_serial_mod.o psb_serial_mod.o\
psb_desc_mod.o: psb_penv_mod.o psb_realloc_mod.o\
psb_hash_mod.o psb_hash_map_mod.o psb_list_map_mod.o \
psb_repl_map_mod.o psb_gen_block_map_mod.o psb_desc_const_mod.o\
psb_indx_map_mod.o
psb_indx_map_mod.o psb_i_vect_mod.o
psb_indx_map_mod.o: psb_desc_const_mod.o psb_error_mod.o psb_penv_mod.o
psb_hash_map_mod.o psb_list_map_mod.o psb_repl_map_mod.o psb_gen_block_map_mod.o:\
psb_indx_map_mod.o psb_desc_const_mod.o \
base/modules/psb_c_base_vect_mod.f90
+36 -2
View File
@@ -46,6 +46,7 @@ module psb_c_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_c_base_vect_type
@@ -141,9 +142,11 @@ module psb_c_base_vect_mod
!
procedure, pass(x) :: gthab => c_base_gthab
procedure, pass(x) :: gthzv => c_base_gthzv
generic, public :: gth => gthab, gthzv
procedure, pass(x) :: gthzv_x => c_base_gthzv_x
generic, public :: gth => gthab, gthzv, gthzv_x
procedure, pass(y) :: sctb => c_base_sctb
generic, public :: sct => sctb
procedure, pass(y) :: sctb_x => c_base_sctb_x
generic, public :: sct => sctb, sctb_x
end type psb_c_base_vect_type
public :: psb_c_base_vect
@@ -1042,6 +1045,26 @@ contains
call psi_gth(n,idx,alpha,x%v,beta,y)
end subroutine c_base_gthab
!
! shortcut alpha=1 beta=0
!
!> Function base_gthzv
!! \memberof psb_c_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine c_base_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
complex(psb_spk_) :: y(:)
class(psb_c_base_vect_type) :: x
call x%gth(n,idx%v(i:),y)
end subroutine c_base_gthzv_x
!
! shortcut alpha=1 beta=0
!
@@ -1087,4 +1110,15 @@ contains
end subroutine c_base_sctb
subroutine c_base_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
complex(psb_spk_) :: beta, x(:)
class(psb_c_base_vect_type) :: y
call y%sct(n,idx%v(i:),x,beta)
end subroutine c_base_sctb_x
end module psb_c_base_vect_mod
base/modules/psb_c_linmap_mod.f90
+9 -2
View File
@@ -50,6 +50,7 @@ module psb_c_linmap_mod
procedure, pass(map) :: is_asb => c_is_asb
procedure, pass(map) :: free => c_free
procedure, pass(map) :: clone => c_clone
procedure, pass(map) :: cnv => psb_c_map_cscnv
end type psb_clinmap_type
@@ -159,17 +160,23 @@ contains
end function c_is_asb
subroutine psb_c_map_cscnv(map,info,type,mold)
subroutine psb_c_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_c_mat_mod
implicit none
type(psb_clinmap_type), intent(inout) :: map
class(psb_clinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_c_base_sparse_mat), intent(in), optional :: mold
class(psb_i_base_vect_type), intent(in), optional :: imold
call map%map_X2Y%cscnv(info,type=type,mold=mold)
if (info == psb_success_)&
& call map%map_Y2X%cscnv(info,type=type,mold=mold)
if (present(imold)) then
call map%desc_X%cnv(mold=imold)
call map%desc_Y%cnv(mold=imold)
end if
end subroutine psb_c_map_cscnv
base/modules/psb_c_tools_mod.f90
+3 -3
View File
@@ -227,9 +227,9 @@ Module psb_c_tools_mod
& psb_c_base_vect_type, psb_c_vect_type, &
& psb_cspmat_type, psb_c_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
Type(psb_cspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in),optional :: extype
end Subroutine psb_ccdbldext
base/modules/psb_c_vect_mod.F90
+9 -7
View File
@@ -578,21 +578,23 @@ contains
subroutine c_vect_cnv(x,mold)
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_base_vect_type), intent(in) :: mold
class(psb_c_base_vect_type), intent(in), optional :: mold
class(psb_c_base_vect_type), allocatable :: tmp
complex(psb_spk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
call move_alloc(tmp,x%v)
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if
end subroutine c_vect_cnv
end module psb_c_vect_mod
base/modules/psb_cd_tools_mod.f90
+11 -9
View File
@@ -73,9 +73,9 @@ module psb_cd_tools_mod
implicit none
!....parameters...
type(psb_desc_type), intent(in) :: desc_in
type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), intent(out) :: info
type(psb_desc_type), intent(inout) :: desc_in
type(psb_desc_type), intent(out) :: desc_out
integer(psb_ipk_), intent(out) :: info
end subroutine psb_cdcpy
end interface
@@ -113,7 +113,7 @@ module psb_cd_tools_mod
Subroutine psb_cd_lstext(desc_a,in_list,desc_ov,info, mask,extype)
import :: psb_ipk_, psb_desc_type
Implicit None
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(inout), target :: desc_a
integer(psb_ipk_), intent(in) :: in_list(:)
Type(psb_desc_type), Intent(out) :: desc_ov
integer(psb_ipk_), intent(out) :: info
@@ -144,11 +144,12 @@ module psb_cd_tools_mod
end interface
interface psb_icdasb
subroutine psb_icdasb(desc,info,ext_hv)
import :: psb_ipk_, psb_desc_type
subroutine psb_icdasb(desc,info,ext_hv, mold)
import :: psb_ipk_, psb_desc_type, psb_i_base_vect_type
Type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
logical, intent(in),optional :: ext_hv
class(psb_i_base_vect_type), optional, intent(in) :: mold
end subroutine psb_icdasb
end interface
@@ -200,12 +201,13 @@ contains
end subroutine psb_get_boundary
subroutine psb_cdasb(desc,info)
subroutine psb_cdasb(desc,info,mold)
Type(psb_desc_type), intent(inout) :: desc
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type), optional, intent(in) :: mold
call psb_icdasb(desc,info,ext_hv=.false.)
call psb_icdasb(desc,info,ext_hv=.false.,mold=mold)
end subroutine psb_cdasb
end module psb_cd_tools_mod
base/modules/psb_d_base_vect_mod.f90
+36 -2
View File
@@ -46,6 +46,7 @@ module psb_d_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_d_base_vect_type
@@ -141,9 +142,11 @@ module psb_d_base_vect_mod
!
procedure, pass(x) :: gthab => d_base_gthab
procedure, pass(x) :: gthzv => d_base_gthzv
generic, public :: gth => gthab, gthzv
procedure, pass(x) :: gthzv_x => d_base_gthzv_x
generic, public :: gth => gthab, gthzv, gthzv_x
procedure, pass(y) :: sctb => d_base_sctb
generic, public :: sct => sctb
procedure, pass(y) :: sctb_x => d_base_sctb_x
generic, public :: sct => sctb, sctb_x
end type psb_d_base_vect_type
public :: psb_d_base_vect
@@ -1043,6 +1046,26 @@ contains
call psi_gth(n,idx,alpha,x%v,beta,y)
end subroutine d_base_gthab
!
! shortcut alpha=1 beta=0
!
!> Function base_gthzv
!! \memberof psb_d_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine d_base_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
real(psb_dpk_) :: y(:)
class(psb_d_base_vect_type) :: x
call x%gth(n,idx%v(i:),y)
end subroutine d_base_gthzv_x
!
! shortcut alpha=1 beta=0
!
@@ -1088,4 +1111,15 @@ contains
end subroutine d_base_sctb
subroutine d_base_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
real(psb_dpk_) :: beta, x(:)
class(psb_d_base_vect_type) :: y
call y%sct(n,idx%v(i:),x,beta)
end subroutine d_base_sctb_x
end module psb_d_base_vect_mod
base/modules/psb_d_linmap_mod.f90
+9 -2
View File
@@ -50,6 +50,7 @@ module psb_d_linmap_mod
procedure, pass(map) :: is_asb => d_is_asb
procedure, pass(map) :: free => d_free
procedure, pass(map) :: clone => d_clone
procedure, pass(map) :: cnv => psb_d_map_cscnv
end type psb_dlinmap_type
@@ -159,17 +160,23 @@ contains
end function d_is_asb
subroutine psb_d_map_cscnv(map,info,type,mold)
subroutine psb_d_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_d_mat_mod
implicit none
type(psb_dlinmap_type), intent(inout) :: map
class(psb_dlinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_d_base_sparse_mat), intent(in), optional :: mold
class(psb_i_base_vect_type), intent(in), optional :: imold
call map%map_X2Y%cscnv(info,type=type,mold=mold)
if (info == psb_success_)&
& call map%map_Y2X%cscnv(info,type=type,mold=mold)
if (present(imold)) then
call map%desc_X%cnv(mold=imold)
call map%desc_Y%cnv(mold=imold)
end if
end subroutine psb_d_map_cscnv
base/modules/psb_d_tools_mod.f90
+3 -3
View File
@@ -227,9 +227,9 @@ Module psb_d_tools_mod
& psb_d_base_vect_type, psb_d_vect_type, &
& psb_dspmat_type, psb_d_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
Type(psb_dspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in),optional :: extype
end Subroutine psb_dcdbldext
base/modules/psb_d_vect_mod.F90
+9 -7
View File
@@ -578,21 +578,23 @@ contains
subroutine d_vect_cnv(x,mold)
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_base_vect_type), intent(in) :: mold
class(psb_d_base_vect_type), intent(in), optional :: mold
class(psb_d_base_vect_type), allocatable :: tmp
real(psb_dpk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
call move_alloc(tmp,x%v)
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if
end subroutine d_vect_cnv
end module psb_d_vect_mod
base/modules/psb_desc_mod.F90
+133 -3
View File
@@ -37,9 +37,9 @@
module psb_desc_mod
use psb_const_mod
use psb_hash_mod
use psb_desc_const_mod
use psb_indx_map_mod
use psb_i_vect_mod
implicit none
@@ -202,8 +202,14 @@ module psb_desc_mod
integer(psb_ipk_), allocatable :: halo_index(:)
integer(psb_ipk_), allocatable :: ext_index(:)
integer(psb_ipk_), allocatable :: ovrlap_index(:)
integer(psb_ipk_), allocatable :: ovrlap_elem(:,:)
integer(psb_ipk_), allocatable :: ovr_mst_idx(:)
type(psb_i_vect_type) :: v_halo_index
type(psb_i_vect_type) :: v_ext_index
type(psb_i_vect_type) :: v_ovrlap_index
type(psb_i_vect_type) :: v_ovr_mst_idx
integer(psb_ipk_), allocatable :: ovrlap_elem(:,:)
integer(psb_ipk_), allocatable :: bnd_elem(:)
class(psb_indx_map), allocatable :: indxmap
integer(psb_ipk_), allocatable :: lprm(:)
@@ -225,9 +231,12 @@ module psb_desc_mod
procedure, pass(desc) :: get_local_cols => psb_cd_get_local_cols
procedure, pass(desc) :: get_global_rows => psb_cd_get_global_rows
procedure, pass(desc) :: get_global_cols => psb_cd_get_global_cols
procedure, pass(desc) :: get_list => psb_cd_get_list
procedure, pass(desc) :: a_get_list => psb_cd_get_list
procedure, pass(desc) :: v_get_list => psb_cd_v_get_list
generic, public :: get_list => a_get_list, v_get_list
procedure, pass(desc) :: sizeof => psb_cd_sizeof
procedure, pass(desc) :: clone => psb_cd_clone
procedure, pass(desc) :: cnv => psb_cd_cnv
procedure, pass(desc) :: free => psb_cdfree
procedure, pass(desc) :: destroy => psb_cd_destroy
procedure, pass(desc) :: nullify => nullify_desc
@@ -309,6 +318,10 @@ contains
if (allocated(desc%lprm)) val = val + psb_sizeof_int*size(desc%lprm)
if (allocated(desc%idx_space)) val = val + psb_sizeof_int*size(desc%idx_space)
if (allocated(desc%indxmap)) val = val + desc%indxmap%sizeof()
val = val + desc%v_halo_index%sizeof()
val = val + desc%v_ext_index%sizeof()
val = val + desc%v_ovrlap_index%sizeof()
val = val + desc%v_ovr_mst_idx%sizeof()
end function psb_cd_sizeof
@@ -597,6 +610,19 @@ contains
end subroutine psb_get_xch_idx
subroutine psb_get_v_xch_idx(idx,totxch,totsnd,totrcv)
implicit none
class(psb_i_base_vect_type), intent(in) :: idx
integer(psb_ipk_), intent(out) :: totxch,totsnd,totrcv
integer(psb_ipk_) :: ip, nerv, nesd
character(len=20), parameter :: name='psb_get_v_xch_idx'
call psb_get_xch_idx(idx%v,totxch,totsnd,totrcv)
end subroutine psb_get_v_xch_idx
subroutine psb_cd_get_list(data,desc,ipnt,totxch,idxr,idxs,info)
use psb_const_mod
@@ -666,6 +692,86 @@ contains
return
end subroutine psb_cd_get_list
subroutine psb_cd_v_get_list(data,desc,ipnt,totxch,idxr,idxs,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
implicit none
integer(psb_ipk_), intent(in) :: data
class(psb_i_base_vect_type), pointer :: ipnt
class(psb_desc_type), target :: desc
integer(psb_ipk_), intent(out) :: totxch,idxr,idxs,info
!locals
integer(psb_ipk_) :: np,me,ictxt,err_act, debug_level,debug_unit
logical, parameter :: debug=.false.,debugprt=.false.
character(len=20), parameter :: name='psb_cd_v_get_list'
info = psb_success_
call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
ictxt = psb_cd_get_context(desc)
call psb_info(ictxt, me, np)
select case(data)
case(psb_comm_halo_)
ipnt => desc%v_halo_index%v
if (.not.allocated(desc%v_halo_index%v)) &
& info = psb_err_inconsistent_index_lists_
case(psb_comm_ovr_)
ipnt => desc%v_ovrlap_index%v
if (.not.allocated(desc%v_ovrlap_index%v)) &
& info = psb_err_inconsistent_index_lists_
case(psb_comm_ext_)
ipnt => desc%v_ext_index%v
if (.not.allocated(desc%v_ext_index%v)) &
& info = psb_err_inconsistent_index_lists_
if (debug_level >= psb_debug_ext_) then
if (.not.associated(desc%base_desc)) then
write(debug_unit,*) trim(name),&
& ': Warning: trying to get ext_index on a descriptor ',&
& 'which does not have a base_desc!'
end if
if (.not.psb_is_ovl_desc(desc)) then
write(debug_unit,*) trim(name),&
& ': Warning: trying to get ext_index on a descriptor ',&
& 'which is not overlap-extended!'
end if
end if
case(psb_comm_mov_)
ipnt => desc%v_ovr_mst_idx%v
if (.not.allocated(desc%v_ovr_mst_idx%v)) &
& info = psb_err_inconsistent_index_lists_
case default
info=psb_err_from_subroutine_
end select
if (info /= psb_success_) then
call psb_errpush(info,name,a_err='wrong Data selector')
goto 9999
end if
call psb_get_v_xch_idx(ipnt,totxch,idxs,idxr)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cd_v_get_list
!
! Subroutine: psb_cdfree
! Frees a descriptor data structure.
@@ -752,6 +858,10 @@ contains
call desc%indxmap%free()
deallocate(desc%indxmap, stat=info)
end if
call desc%v_halo_index%free(info)
call desc%v_ovrlap_index%free(info)
call desc%v_ext_index%free(info)
call desc%v_ovr_mst_idx%free(info)
call desc%nullify()
@@ -820,6 +930,15 @@ contains
& call psb_move_alloc( desc_in%idx_space , desc_out%idx_space , info)
if (info == psb_success_) &
& call move_alloc(desc_in%indxmap, desc_out%indxmap)
if (info == psb_success_) &
& call desc_in%v_halo_index%clone(desc_out%v_halo_index,info)
if (info == psb_success_) &
& call desc_in%v_ext_index%clone(desc_out%v_ext_index,info)
if (info == psb_success_) &
& call desc_in%v_ovrlap_index%clone(desc_out%v_ovrlap_index,info)
if (info == psb_success_) &
& call desc_in%v_ovr_mst_idx%clone(desc_out%v_ovr_mst_idx,info)
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name)
@@ -951,6 +1070,17 @@ contains
end Subroutine psb_cd_get_recv_idx
subroutine psb_cd_cnv(desc, mold)
class(psb_desc_type), intent(inout), target :: desc
class(psb_i_base_vect_type), intent(in) :: mold
call desc%v_halo_index%cnv(mold)
call desc%v_ext_index%cnv(mold)
call desc%v_ovrlap_index%cnv(mold)
call desc%v_ovr_mst_idx%cnv(mold)
end subroutine psb_cd_cnv
subroutine cd_l2gs1(idx,desc,info,mask,owned)
use psb_error_mod
base/modules/psb_i_base_vect_mod.f90
+1 -1
View File
@@ -574,7 +574,7 @@ contains
!
function i_base_get_vect(x) result(res)
class(psb_i_base_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
if (.not.allocated(x%v)) return
base/modules/psb_i_vect_mod.F90
+16 -13
View File
@@ -152,7 +152,7 @@ contains
function i_vect_get_vect(x) result(res)
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_), allocatable :: res(:)
integer(psb_ipk_) :: info
if (allocated(x%v)) then
@@ -558,10 +558,10 @@ contains
use psi_serial_mod
implicit none
class(psb_i_vect_type), intent(inout) :: x
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in) :: n, dupl
integer(psb_ipk_), intent(in) :: irl(:)
integer(psb_ipk_), intent(in) :: val(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i
@@ -578,21 +578,24 @@ contains
subroutine i_vect_cnv(x,mold)
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_base_vect_type), intent(in) :: mold
class(psb_i_base_vect_type), intent(in), optional :: mold
class(psb_i_base_vect_type), allocatable :: tmp
integer(psb_ipk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
call move_alloc(tmp,x%v)
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if
end subroutine i_vect_cnv
end module psb_i_vect_mod
base/modules/psb_s_base_vect_mod.f90
+36 -2
View File
@@ -46,6 +46,7 @@ module psb_s_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_s_base_vect_type
@@ -141,9 +142,11 @@ module psb_s_base_vect_mod
!
procedure, pass(x) :: gthab => s_base_gthab
procedure, pass(x) :: gthzv => s_base_gthzv
generic, public :: gth => gthab, gthzv
procedure, pass(x) :: gthzv_x => s_base_gthzv_x
generic, public :: gth => gthab, gthzv, gthzv_x
procedure, pass(y) :: sctb => s_base_sctb
generic, public :: sct => sctb
procedure, pass(y) :: sctb_x => s_base_sctb_x
generic, public :: sct => sctb, sctb_x
end type psb_s_base_vect_type
public :: psb_s_base_vect
@@ -1042,6 +1045,26 @@ contains
call psi_gth(n,idx,alpha,x%v,beta,y)
end subroutine s_base_gthab
!
! shortcut alpha=1 beta=0
!
!> Function base_gthzv
!! \memberof psb_s_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine s_base_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
real(psb_spk_) :: y(:)
class(psb_s_base_vect_type) :: x
call x%gth(n,idx%v(i:),y)
end subroutine s_base_gthzv_x
!
! shortcut alpha=1 beta=0
!
@@ -1087,4 +1110,15 @@ contains
end subroutine s_base_sctb
subroutine s_base_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
real(psb_spk_) :: beta, x(:)
class(psb_s_base_vect_type) :: y
call y%sct(n,idx%v(i:),x,beta)
end subroutine s_base_sctb_x
end module psb_s_base_vect_mod
base/modules/psb_s_linmap_mod.f90
+9 -2
View File
@@ -50,6 +50,7 @@ module psb_s_linmap_mod
procedure, pass(map) :: is_asb => s_is_asb
procedure, pass(map) :: free => s_free
procedure, pass(map) :: clone => s_clone
procedure, pass(map) :: cnv => psb_s_map_cscnv
end type psb_slinmap_type
@@ -159,17 +160,23 @@ contains
end function s_is_asb
subroutine psb_s_map_cscnv(map,info,type,mold)
subroutine psb_s_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_s_mat_mod
implicit none
type(psb_slinmap_type), intent(inout) :: map
class(psb_slinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_s_base_sparse_mat), intent(in), optional :: mold
class(psb_i_base_vect_type), intent(in), optional :: imold
call map%map_X2Y%cscnv(info,type=type,mold=mold)
if (info == psb_success_)&
& call map%map_Y2X%cscnv(info,type=type,mold=mold)
if (present(imold)) then
call map%desc_X%cnv(mold=imold)
call map%desc_Y%cnv(mold=imold)
end if
end subroutine psb_s_map_cscnv
base/modules/psb_s_tools_mod.f90
+3 -3
View File
@@ -227,9 +227,9 @@ Module psb_s_tools_mod
& psb_s_base_vect_type, psb_s_vect_type, &
& psb_sspmat_type, psb_s_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr
Type(psb_sspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
Type(psb_sspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in),optional :: extype
end Subroutine psb_scdbldext
base/modules/psb_s_vect_mod.F90
+9 -7
View File
@@ -578,21 +578,23 @@ contains
subroutine s_vect_cnv(x,mold)
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_base_vect_type), intent(in) :: mold
class(psb_s_base_vect_type), intent(in), optional :: mold
class(psb_s_base_vect_type), allocatable :: tmp
real(psb_spk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
call move_alloc(tmp,x%v)
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if
end subroutine s_vect_cnv
end module psb_s_vect_mod
base/modules/psb_z_base_vect_mod.f90
+36 -2
View File
@@ -46,6 +46,7 @@ module psb_z_base_vect_mod
use psb_const_mod
use psb_error_mod
use psb_i_base_vect_mod
!> \namespace psb_base_mod \class psb_z_base_vect_type
@@ -141,9 +142,11 @@ module psb_z_base_vect_mod
!
procedure, pass(x) :: gthab => z_base_gthab
procedure, pass(x) :: gthzv => z_base_gthzv
generic, public :: gth => gthab, gthzv
procedure, pass(x) :: gthzv_x => z_base_gthzv_x
generic, public :: gth => gthab, gthzv, gthzv_x
procedure, pass(y) :: sctb => z_base_sctb
generic, public :: sct => sctb
procedure, pass(y) :: sctb_x => z_base_sctb_x
generic, public :: sct => sctb, sctb_x
end type psb_z_base_vect_type
public :: psb_z_base_vect
@@ -1042,6 +1045,26 @@ contains
call psi_gth(n,idx,alpha,x%v,beta,y)
end subroutine z_base_gthab
!
! shortcut alpha=1 beta=0
!
!> Function base_gthzv
!! \memberof psb_z_base_vect_type
!! \brief gather into an array special alpha=1 beta=0
!! Y = X(IDX(:))
!! \param n how many entries to consider
!! \param idx(:) indices
subroutine z_base_gthzv_x(i,n,idx,x,y)
use psi_serial_mod
integer(psb_ipk_) :: i,n
class(psb_i_base_vect_type) :: idx
complex(psb_dpk_) :: y(:)
class(psb_z_base_vect_type) :: x
call x%gth(n,idx%v(i:),y)
end subroutine z_base_gthzv_x
!
! shortcut alpha=1 beta=0
!
@@ -1087,4 +1110,15 @@ contains
end subroutine z_base_sctb
subroutine z_base_sctb_x(i,n,idx,x,beta,y)
use psi_serial_mod
integer(psb_ipk_) :: i, n
class(psb_i_base_vect_type) :: idx
complex(psb_dpk_) :: beta, x(:)
class(psb_z_base_vect_type) :: y
call y%sct(n,idx%v(i:),x,beta)
end subroutine z_base_sctb_x
end module psb_z_base_vect_mod
base/modules/psb_z_linmap_mod.f90
+9 -2
View File
@@ -50,6 +50,7 @@ module psb_z_linmap_mod
procedure, pass(map) :: is_asb => z_is_asb
procedure, pass(map) :: free => z_free
procedure, pass(map) :: clone => z_clone
procedure, pass(map) :: cnv => psb_z_map_cscnv
end type psb_zlinmap_type
@@ -159,17 +160,23 @@ contains
end function z_is_asb
subroutine psb_z_map_cscnv(map,info,type,mold)
subroutine psb_z_map_cscnv(map,info,type,mold,imold)
use psb_i_vect_mod
use psb_z_mat_mod
implicit none
type(psb_zlinmap_type), intent(inout) :: map
class(psb_zlinmap_type), intent(inout) :: map
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: type
class(psb_z_base_sparse_mat), intent(in), optional :: mold
class(psb_i_base_vect_type), intent(in), optional :: imold
call map%map_X2Y%cscnv(info,type=type,mold=mold)
if (info == psb_success_)&
& call map%map_Y2X%cscnv(info,type=type,mold=mold)
if (present(imold)) then
call map%desc_X%cnv(mold=imold)
call map%desc_Y%cnv(mold=imold)
end if
end subroutine psb_z_map_cscnv
base/modules/psb_z_tools_mod.f90
+3 -3
View File
@@ -227,9 +227,9 @@ Module psb_z_tools_mod
& psb_z_base_vect_type, psb_z_vect_type, &
& psb_zspmat_type, psb_z_base_sparse_mat
integer(psb_ipk_), intent(in) :: novr
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(in), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
Type(psb_zspmat_type), Intent(in) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_desc_type), Intent(out) :: desc_ov
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(in),optional :: extype
end Subroutine psb_zcdbldext
base/modules/psb_z_vect_mod.F90
+9 -7
View File
@@ -578,21 +578,23 @@ contains
subroutine z_vect_cnv(x,mold)
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_base_vect_type), intent(in) :: mold
class(psb_z_base_vect_type), intent(in), optional :: mold
class(psb_z_base_vect_type), allocatable :: tmp
complex(psb_dpk_), allocatable :: invect(:)
integer(psb_ipk_) :: info
if (present(mold)) then
#ifdef HAVE_MOLD
allocate(tmp,stat=info,mold=mold)
#else
call mold%mold(tmp,info)
#endif
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
call move_alloc(tmp,x%v)
if (allocated(x%v)) then
call x%v%sync()
if (info == psb_success_) call tmp%bld(x%v%v)
call x%v%free(info)
end if
call move_alloc(tmp,x%v)
end if
end subroutine z_vect_cnv
end module psb_z_vect_mod
base/modules/psi_c_mod.f90
+11 -1
View File
@@ -30,7 +30,7 @@
!!$
!!$
module psi_c_mod
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_
use psb_desc_mod, only : psb_desc_type, psb_spk_, psb_ipk_, psb_i_base_vect_type
use psb_c_vect_mod, only : psb_c_base_vect_type
interface psi_swapdata
@@ -90,6 +90,16 @@ module psi_c_mod
complex(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_cswapidx_vect
subroutine psi_cswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_c_base_vect_type, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_vect_type) :: y
complex(psb_spk_) :: beta
complex(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(in) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_cswap_vidx_vect
end interface
base/modules/psi_d_mod.f90
+12 -1
View File
@@ -30,8 +30,9 @@
!!$
!!$
module psi_d_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type
use psb_d_vect_mod, only : psb_d_base_vect_type
interface psi_swapdata
subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type
@@ -89,6 +90,16 @@ module psi_d_mod
real(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_dswapidx_vect
subroutine psi_dswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_d_base_vect_type, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_vect_type) :: y
real(psb_dpk_) :: beta
real(psb_dpk_), target :: work(:)
class(psb_i_base_vect_type), intent(in) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_dswap_vidx_vect
end interface
base/modules/psi_i_mod.f90
+3 -2
View File
@@ -139,11 +139,12 @@ module psi_i_mod
end interface
interface psi_cnv_dsc
subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info)
import :: psb_desc_type, psb_ipk_
subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info, mold)
import :: psb_desc_type, psb_ipk_, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: halo_in(:), ovrlap_in(:),ext_in(:)
type(psb_desc_type), intent(inout) :: cdesc
integer(psb_ipk_), intent(out) :: info
class(psb_i_base_vect_type), optional, intent(in) :: mold
end subroutine psi_cnv_dsc
end interface
base/modules/psi_s_mod.f90
+11 -1
View File
@@ -30,7 +30,7 @@
!!$
!!$
module psi_s_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_spk_, psb_i_base_vect_type
use psb_s_vect_mod, only : psb_s_base_vect_type
interface psi_swapdata
@@ -90,6 +90,16 @@ module psi_s_mod
real(psb_spk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_sswapidx_vect
subroutine psi_sswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_spk_, psb_s_base_vect_type, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_vect_type) :: y
real(psb_spk_) :: beta
real(psb_spk_), target :: work(:)
class(psb_i_base_vect_type), intent(in) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_sswap_vidx_vect
end interface
base/modules/psi_z_mod.f90
+11 -1
View File
@@ -30,7 +30,7 @@
!!$
!!$
module psi_z_mod
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_
use psb_desc_mod, only : psb_desc_type, psb_ipk_, psb_dpk_, psb_i_base_vect_type
use psb_z_vect_mod, only : psb_z_base_vect_type
interface psi_swapdata
@@ -90,6 +90,16 @@ module psi_z_mod
complex(psb_dpk_),target :: work(:)
integer(psb_ipk_), intent(in) :: idx(:),totxch,totsnd,totrcv
end subroutine psi_zswapidx_vect
subroutine psi_zswap_vidx_vect(iictxt,iicomm,flag,beta,y,idx,totxch,totsnd,totrcv,work,info)
import :: psb_desc_type, psb_ipk_, psb_dpk_, psb_z_base_vect_type, psb_i_base_vect_type
integer(psb_ipk_), intent(in) :: iictxt,iicomm,flag
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_vect_type) :: y
complex(psb_dpk_) :: beta
complex(psb_dpk_), target :: work(:)
class(psb_i_base_vect_type), intent(in) :: idx
integer(psb_ipk_), intent(in) :: totxch,totsnd, totrcv
end subroutine psi_zswap_vidx_vect
end interface