mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
psblas:
base/internals/Makefile base/internals/psi_dswapdata.F90 base/internals/psi_dswaptran.F90 base/internals/psi_iswapdata.F90 base/internals/psi_iswaptran.F90 base/internals/psi_zswapdata.F90 base/internals/psi_zswaptran.F90 base/modules/Makefile base/modules/psb_base_mod.f90 base/modules/psb_desc_type.f90 base/modules/psb_inter_desc_type.f90 base/modules/psb_realloc_mod.F90 base/modules/psb_serial_mod.f90 base/modules/psb_spmat_type.f90 base/modules/psb_tools_mod.f90 base/modules/psi_mod.f90 base/modules/psi_serial_mod.f90 base/tools/psb_cdcpy.f90 base/tools/psb_dcdovr.F90 base/tools/psb_glob_to_loc.f90 base/tools/psb_loc_to_glob.f90 base/tools/psb_zcdovr.F90 Merged changes from psblas-intermesh branch up to rev. 2809.
This commit is contained in:
Salvatore Filippone
+13
-13
@@ -78,19 +78,19 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
call psb_safe_cpy(desc_in%matrix_data,desc_out%matrix_data,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%halo_index,desc_out%halo_index,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%ext_index,desc_out%ext_index,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%ovrlap_index,desc_out%ovrlap_index,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%bnd_elem,desc_out%bnd_elem,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%ovrlap_elem,desc_out%ovrlap_elem,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%ovr_mst_idx,desc_out%ovr_mst_idx,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%loc_to_glob,desc_out%loc_to_glob,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%glob_to_loc,desc_out%glob_to_loc,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%lprm,desc_out%lprm,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%idx_space,desc_out%idx_space,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%hashv,desc_out%hashv,info)
|
||||
if (info == 0) call psb_safe_cpy(desc_in%glb_lc,desc_out%glb_lc,info)
|
||||
call psb_safe_ab_cpy(desc_in%matrix_data,desc_out%matrix_data,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%halo_index,desc_out%halo_index,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%ext_index,desc_out%ext_index,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%ovrlap_index,desc_out%ovrlap_index,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%bnd_elem,desc_out%bnd_elem,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%ovrlap_elem,desc_out%ovrlap_elem,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%ovr_mst_idx,desc_out%ovr_mst_idx,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%loc_to_glob,desc_out%loc_to_glob,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%glob_to_loc,desc_out%glob_to_loc,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%lprm,desc_out%lprm,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%idx_space,desc_out%idx_space,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%hashv,desc_out%hashv,info)
|
||||
if (info == 0) call psb_safe_ab_cpy(desc_in%glb_lc,desc_out%glb_lc,info)
|
||||
|
||||
if (info == 0) then
|
||||
if (allocated(desc_in%ptree)) then
|
||||
|
||||
+18
-16
@@ -78,11 +78,11 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
|
||||
! .. Array Arguments ..
|
||||
integer, intent(in) :: novr
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in) :: desc_a
|
||||
Type(psb_desc_type), Intent(out) :: desc_ov
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in),optional :: extype
|
||||
Type(psb_dspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in), target :: desc_a
|
||||
Type(psb_desc_type), Intent(out) :: desc_ov
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in),optional :: extype
|
||||
|
||||
interface
|
||||
subroutine psb_icdasb(desc_a,info,ext_hv)
|
||||
@@ -192,7 +192,8 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1)
|
||||
l_tmp_halo = novr*(3*Size(desc_a%halo_index))
|
||||
|
||||
call psb_cd_set_bld(desc_ov,info)
|
||||
call psb_cd_set_ovl_bld(desc_ov,info)
|
||||
desc_ov%base_desc => desc_a
|
||||
|
||||
If (debug_level >= psb_debug_outer_) then
|
||||
Write(debug_unit,*) me,' ',trim(name),':Start',lworks,lworkr
|
||||
@@ -229,16 +230,16 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
halo(:) = desc_a%halo_index(:)
|
||||
tmp_ovr_idx(:) = -1
|
||||
orig_ovr(:) = -1
|
||||
tmp_halo(:) = -1
|
||||
counter_e = 1
|
||||
tot_recv = 0
|
||||
counter_t = 1
|
||||
counter_h = 1
|
||||
counter_o = 1
|
||||
cntov_o = 1
|
||||
halo(:) = desc_a%halo_index(:)
|
||||
tmp_ovr_idx(:) = -1
|
||||
orig_ovr(:) = -1
|
||||
tmp_halo(:) = -1
|
||||
counter_e = 1
|
||||
tot_recv = 0
|
||||
counter_t = 1
|
||||
counter_h = 1
|
||||
counter_o = 1
|
||||
cntov_o = 1
|
||||
! Init overlap with desc_a%ovrlap (if any)
|
||||
counter = 1
|
||||
Do While (desc_a%ovrlap_index(counter) /= -1)
|
||||
@@ -739,6 +740,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
|
||||
call psb_icdasb(desc_ov,info,ext_hv=.true.)
|
||||
|
||||
call psb_cd_set_ovl_asb(desc_ov,info)
|
||||
|
||||
if (info == 0) call psb_sp_free(blk,info)
|
||||
if (info /= 0) then
|
||||
|
||||
@@ -249,3 +249,38 @@ subroutine psb_glob_to_loc(x,desc_a,info,iact,owned)
|
||||
|
||||
end subroutine psb_glob_to_loc
|
||||
|
||||
subroutine psb_glob_to_loc2s(x,y,desc_a,info,iact,owned)
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod, psb_protect_name => psb_glob_to_loc2s
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(in) :: x
|
||||
integer,intent(out) :: y
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
logical, intent(in), optional :: owned
|
||||
|
||||
integer :: iv1(1), iv2(1)
|
||||
|
||||
iv1(1) = x
|
||||
call psb_glob_to_loc(iv1,iv2,desc_a,info,iact,owned)
|
||||
y = iv2(1)
|
||||
end subroutine psb_glob_to_loc2s
|
||||
|
||||
subroutine psb_glob_to_locs(x,desc_a,info,iact,owned)
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod, psb_protect_name => psb_glob_to_locs
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
logical, intent(in), optional :: owned
|
||||
integer :: iv1(1)
|
||||
|
||||
iv1(1) = x
|
||||
call psb_glob_to_loc(iv1,desc_a,info,iact,owned)
|
||||
x = iv1(1)
|
||||
|
||||
end subroutine psb_glob_to_locs
|
||||
|
||||
|
||||
@@ -249,3 +249,36 @@ subroutine psb_loc_to_glob(x,desc_a,info,iact)
|
||||
|
||||
end subroutine psb_loc_to_glob
|
||||
|
||||
subroutine psb_loc_to_glob2s(x,y,desc_a,info,iact)
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod, psb_protect_name => psb_loc_to_glob2s
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(in) :: x
|
||||
integer,intent(out) :: y
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
|
||||
integer :: iv1(1), iv2(1)
|
||||
|
||||
iv1(1) = x
|
||||
call psb_loc_to_glob(iv1,iv2,desc_a,info,iact)
|
||||
y = iv2(1)
|
||||
end subroutine psb_loc_to_glob2s
|
||||
|
||||
subroutine psb_loc_to_globs(x,desc_a,info,iact)
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod, psb_protect_name => psb_loc_to_globs
|
||||
implicit none
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer,intent(inout) :: x
|
||||
integer, intent(out) :: info
|
||||
character, intent(in), optional :: iact
|
||||
integer :: iv1(1)
|
||||
|
||||
iv1(1) = x
|
||||
call psb_loc_to_glob(iv1,desc_a,info,iact)
|
||||
x = iv1(1)
|
||||
|
||||
end subroutine psb_loc_to_globs
|
||||
|
||||
|
||||
+16
-10
@@ -77,11 +77,11 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
|
||||
! .. Array Arguments ..
|
||||
integer, intent(in) :: novr
|
||||
Type(psb_zspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in) :: desc_a
|
||||
Type(psb_desc_type), Intent(out) :: desc_ov
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in),optional :: extype
|
||||
Type(psb_zspmat_type), Intent(in) :: a
|
||||
Type(psb_desc_type), Intent(in), target :: desc_a
|
||||
Type(psb_desc_type), Intent(out) :: desc_ov
|
||||
integer, intent(out) :: info
|
||||
integer, intent(in),optional :: extype
|
||||
|
||||
interface
|
||||
subroutine psb_icdasb(desc_a,info,ext_hv)
|
||||
@@ -191,7 +191,8 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
l_tmp_ovr_idx = novr*(3*Max(2*index_dim,1)+1)
|
||||
l_tmp_halo = novr*(3*Size(desc_a%halo_index))
|
||||
|
||||
call psb_cd_set_bld(desc_ov,info)
|
||||
call psb_cd_set_ovl_bld(desc_ov,info)
|
||||
desc_ov%base_desc => desc_a
|
||||
|
||||
If (debug_level >= psb_debug_outer_) then
|
||||
Write(debug_unit,*) me,' ',trim(name),':Start',lworks,lworkr
|
||||
@@ -386,7 +387,8 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
|
||||
Enddo
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),':Checktmp_o_i Loop Mid1',tmp_ovr_idx(1:10)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ':Checktmp_o_i Loop Mid1',tmp_ovr_idx(1:10)
|
||||
counter = counter+n_elem_recv
|
||||
|
||||
!
|
||||
@@ -460,16 +462,19 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
tot_elem=i
|
||||
endif
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),':Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ':Checktmp_o_i Loop Mid2',tmp_ovr_idx(1:10)
|
||||
sdsz(proc+1) = tot_elem
|
||||
idxs = idxs + tot_elem
|
||||
end if
|
||||
counter = counter+n_elem_send+3
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),':Checktmp_o_i Loop End',tmp_ovr_idx(1:10)
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ':Checktmp_o_i Loop End',tmp_ovr_idx(1:10)
|
||||
Enddo
|
||||
if (debug_level >= psb_debug_outer_) &
|
||||
& write(debug_unit,*) me,' ',trim(name),':End phase 1', m, n_col, tot_recv
|
||||
& write(debug_unit,*) me,' ',trim(name),&
|
||||
& ':End phase 1', m, n_col, tot_recv
|
||||
|
||||
if (i_ovr <= novr) then
|
||||
!
|
||||
@@ -734,6 +739,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype)
|
||||
|
||||
call psb_icdasb(desc_ov,info,ext_hv=.true.)
|
||||
|
||||
call psb_cd_set_ovl_asb(desc_ov,info)
|
||||
|
||||
if (info == 0) call psb_sp_free(blk,info)
|
||||
if (info /= 0) then
|
||||
|
||||
Reference in New Issue
Block a user