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

Merge branch 'remap-coarse' into development

Browse Source
This commit is contained in:
sfilippone
2026-07-14 12:45:37 +02:00
parent 324bb4b8f3 1542f06d2a
commit caca3613a3
16 changed files with 256 additions and 36 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/Makefile
+4 -4
View File
@@ -413,10 +413,10 @@ tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o: desc/psb_desc_mod.o psi_mod
tools/psb_i_tools_mod.o: serial/psb_i_vect_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o
tools/psb_l_tools_mod.o: serial/psb_l_vect_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o
tools/psb_s_tools_mod.o: serial/psb_s_vect_mod.o
tools/psb_d_tools_mod.o: serial/psb_d_vect_mod.o
tools/psb_c_tools_mod.o: serial/psb_c_vect_mod.o
tools/psb_z_tools_mod.o: serial/psb_z_vect_mod.o
tools/psb_s_tools_mod.o: serial/psb_s_vect_mod.o comm/psb_s_linmap_mod.o
tools/psb_d_tools_mod.o: serial/psb_d_vect_mod.o comm/psb_d_linmap_mod.o
tools/psb_c_tools_mod.o: serial/psb_c_vect_mod.o comm/psb_c_linmap_mod.o
tools/psb_z_tools_mod.o: serial/psb_z_vect_mod.o comm/psb_z_linmap_mod.o
psblas/psb_s_psblas_mod.o: serial/psb_s_vect_mod.o serial/psb_s_mat_mod.o
psblas/psb_d_psblas_mod.o: serial/psb_d_vect_mod.o serial/psb_d_mat_mod.o
base/modules/comm/psb_base_linmap_mod.f90
+46 -2
View File
@@ -57,6 +57,10 @@ module psb_base_linmap_mod
procedure, pass(map) :: set_kind => base_set_kind
procedure, pass(map) :: free => base_free
procedure, pass(map) :: clone => base_clone
procedure, pass(map) :: set_pU => base_set_pU
procedure, pass(map) :: set_pV => base_set_pV
procedure, pass(map) :: get_pU => base_get_pU
procedure, pass(map) :: get_pV => base_get_pV
end type psb_base_linmap_type
@@ -134,8 +138,13 @@ contains
if (.not.associated(map%p_desc_U)) return
if (.not.associated(map%p_desc_V)) return
res = map%p_desc_U%is_asb().and.map%p_desc_V%is_asb()
!!$ write(0,*) 'map_aggr ',map%p_desc_U%is_asb(),map%p_desc_V%is_asb()
case(psb_map_gen_linear_)
res = map%desc_U%is_asb().and.map%desc_V%is_asb()
res = map%desc_U%is_asb().and.map%desc_V%is_asb()
!!$ write(0,*) 'map_gen_linear ',map%desc_U%is_asb(),map%desc_V%is_asb()
case default
write(0,*) 'Unknown map kind ',map%get_kind(),&
& psb_map_aggr_, psb_map_gen_linear_
end select
end function base_is_asb
@@ -221,7 +230,42 @@ contains
if (map%desc_V%is_ok()) call map%desc_V%free(info)
end subroutine base_free
subroutine base_set_pU(map,desc)
implicit none
class(psb_base_linmap_type) :: map
type(psb_desc_type), target :: desc
map%p_desc_U => desc
end subroutine base_set_pU
subroutine base_set_pV(map,desc)
implicit none
class(psb_base_linmap_type) :: map
type(psb_desc_type), target :: desc
map%p_desc_V => desc
end subroutine base_set_pV
function base_get_pU(map) result(desc)
implicit none
class(psb_base_linmap_type) :: map
type(psb_desc_type), pointer :: desc
desc => map%p_desc_U
end function base_get_pU
function base_get_pV(map) result(desc)
implicit none
class(psb_base_linmap_type) :: map
type(psb_desc_type), pointer :: desc
desc => map%p_desc_V
end function base_get_pV
end module psb_base_linmap_mod
base/modules/tools/psb_c_tools_mod.F90
+12 -1
View File
@@ -36,9 +36,10 @@ Module psb_c_tools_mod
& psb_lc_csr_sparse_mat, psb_lc_coo_sparse_mat, &
& psb_c_csr_sparse_mat, psb_c_coo_sparse_mat
use psb_l_vect_mod, only : psb_l_vect_type
use psb_c_linmap_mod, only : psb_clinmap_type
use psb_c_multivect_mod, only : psb_c_base_multivect_type, psb_c_multivect_type
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode)
import
@@ -469,6 +470,16 @@ Module psb_c_tools_mod
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_remap
subroutine psb_c_remap2(map_in, desc_new, map_out, flag, info)
import
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_clinmap_type), intent(inout) :: map_in
type(psb_clinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_remap2
end interface psb_remap
end module psb_c_tools_mod
base/modules/tools/psb_d_tools_mod.F90
+12 -1
View File
@@ -36,9 +36,10 @@ Module psb_d_tools_mod
& psb_ld_csr_sparse_mat, psb_ld_coo_sparse_mat, &
& psb_d_csr_sparse_mat, psb_d_coo_sparse_mat
use psb_l_vect_mod, only : psb_l_vect_type
use psb_d_linmap_mod, only : psb_dlinmap_type
use psb_d_multivect_mod, only : psb_d_base_multivect_type, psb_d_multivect_type
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode)
import
@@ -469,6 +470,16 @@ Module psb_d_tools_mod
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_remap
subroutine psb_d_remap2(map_in, desc_new, map_out, flag, info)
import
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_dlinmap_type), intent(inout) :: map_in
type(psb_dlinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_remap2
end interface psb_remap
end module psb_d_tools_mod
base/modules/tools/psb_i_tools_mod.F90
+1 -1
View File
@@ -37,7 +37,7 @@ Module psb_i_tools_mod
use psb_l_vect_mod, only : psb_l_vect_type
use psb_i_multivect_mod, only : psb_i_base_multivect_type, psb_i_multivect_type
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode)
import
base/modules/tools/psb_l_tools_mod.F90
+1 -1
View File
@@ -37,7 +37,7 @@ Module psb_l_tools_mod
! use psb_i_vect_mod, only : psb_i_vect_type
use psb_l_multivect_mod, only : psb_l_base_multivect_type, psb_l_multivect_type
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode)
import
base/modules/tools/psb_s_tools_mod.F90
+12 -1
View File
@@ -36,9 +36,10 @@ Module psb_s_tools_mod
& psb_ls_csr_sparse_mat, psb_ls_coo_sparse_mat, &
& psb_s_csr_sparse_mat, psb_s_coo_sparse_mat
use psb_l_vect_mod, only : psb_l_vect_type
use psb_s_linmap_mod, only : psb_slinmap_type
use psb_s_multivect_mod, only : psb_s_base_multivect_type, psb_s_multivect_type
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode)
import
@@ -469,6 +470,16 @@ Module psb_s_tools_mod
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_remap
subroutine psb_s_remap2(map_in, desc_new, map_out, flag, info)
import
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_slinmap_type), intent(inout) :: map_in
type(psb_slinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_remap2
end interface psb_remap
end module psb_s_tools_mod
base/modules/tools/psb_z_tools_mod.F90
+12 -1
View File
@@ -36,9 +36,10 @@ Module psb_z_tools_mod
& psb_lz_csr_sparse_mat, psb_lz_coo_sparse_mat, &
& psb_z_csr_sparse_mat, psb_z_coo_sparse_mat
use psb_l_vect_mod, only : psb_l_vect_type
use psb_z_linmap_mod, only : psb_zlinmap_type
use psb_z_multivect_mod, only : psb_z_base_multivect_type, psb_z_multivect_type
use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem
interface psb_geall
subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode)
import
@@ -469,6 +470,16 @@ Module psb_z_tools_mod
integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:)
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_remap
subroutine psb_z_remap2(map_in, desc_new, map_out, flag, info)
import
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_zlinmap_type), intent(inout) :: map_in
type(psb_zlinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_remap2
end interface psb_remap
end module psb_z_tools_mod
base/tools/psb_c_map.f90
+24 -4
View File
@@ -56,9 +56,19 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work)
character(len=20), parameter :: name='psb_map_U2V'
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
info = 1
if (.not.map%is_asb()) then
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
info = 1
end block
return
end if
@@ -132,7 +142,17 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
end block
info = 1
return
end if
base/tools/psb_c_remap.F90
+15 -2
View File
@@ -86,7 +86,6 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
endif
!!$ write(0,*) ' Remapping from ',np,' onto ', np_remap
mipd = ipd
if (desc_in%get_fmt() == 'BLOCK') then
!
! Should we spread the processes in the new context,
@@ -121,7 +120,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
goto 9999
endif
if (rnp >= np) then
write(0,*) ' No remapping on larger proc count now'
write(0,*) ' No remapping on larger proc count now',rnp,np
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
@@ -245,6 +244,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
else
naggr(me+1) = 0
end if
ipd = mipd
call psb_sum(ctxt,naggr)
end block
@@ -257,3 +257,16 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
return
end subroutine psb_c_remap
subroutine psb_c_remap2(map_in, desc_new, map_out, flag, info)
use psb_base_mod, psb_protect_name => psb_c_remap2
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_clinmap_type), intent(inout) :: map_in
type(psb_clinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_remap2
base/tools/psb_d_map.f90
+24 -4
View File
@@ -56,9 +56,19 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work)
character(len=20), parameter :: name='psb_map_U2V'
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
info = 1
if (.not.map%is_asb()) then
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
info = 1
end block
return
end if
@@ -132,7 +142,17 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
end block
info = 1
return
end if
base/tools/psb_d_remap.F90
+15 -2
View File
@@ -86,7 +86,6 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
endif
!!$ write(0,*) ' Remapping from ',np,' onto ', np_remap
mipd = ipd
if (desc_in%get_fmt() == 'BLOCK') then
!
! Should we spread the processes in the new context,
@@ -121,7 +120,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
goto 9999
endif
if (rnp >= np) then
write(0,*) ' No remapping on larger proc count now'
write(0,*) ' No remapping on larger proc count now',rnp,np
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
@@ -245,6 +244,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
else
naggr(me+1) = 0
end if
ipd = mipd
call psb_sum(ctxt,naggr)
end block
@@ -257,3 +257,16 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
return
end subroutine psb_d_remap
subroutine psb_d_remap2(map_in, desc_new, map_out, flag, info)
use psb_base_mod, psb_protect_name => psb_d_remap2
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_dlinmap_type), intent(inout) :: map_in
type(psb_dlinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_remap2
base/tools/psb_s_map.f90
+24 -4
View File
@@ -56,9 +56,19 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work)
character(len=20), parameter :: name='psb_map_U2V'
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
info = 1
if (.not.map%is_asb()) then
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
info = 1
end block
return
end if
@@ -132,7 +142,17 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
end block
info = 1
return
end if
base/tools/psb_s_remap.F90
+15 -2
View File
@@ -86,7 +86,6 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
endif
!!$ write(0,*) ' Remapping from ',np,' onto ', np_remap
mipd = ipd
if (desc_in%get_fmt() == 'BLOCK') then
!
! Should we spread the processes in the new context,
@@ -121,7 +120,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
goto 9999
endif
if (rnp >= np) then
write(0,*) ' No remapping on larger proc count now'
write(0,*) ' No remapping on larger proc count now',rnp,np
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
@@ -245,6 +244,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
else
naggr(me+1) = 0
end if
ipd = mipd
call psb_sum(ctxt,naggr)
end block
@@ -257,3 +257,16 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
return
end subroutine psb_s_remap
subroutine psb_s_remap2(map_in, desc_new, map_out, flag, info)
use psb_base_mod, psb_protect_name => psb_s_remap2
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_slinmap_type), intent(inout) :: map_in
type(psb_slinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_remap2
base/tools/psb_z_map.f90
+24 -4
View File
@@ -56,9 +56,19 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work)
character(len=20), parameter :: name='psb_map_U2V'
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
info = 1
if (.not.map%is_asb()) then
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
info = 1
end block
return
end if
@@ -132,7 +142,17 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty)
info = psb_success_
if (.not.map%is_asb()) then
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled'
block
integer(psb_ipk_) :: meu,npu,mev,npv
type(psb_ctxt_type) :: ct
ct = map%p_desc_u%get_context()
call psb_info(ct,meu,npu)
ct = map%p_desc_v%get_context()
call psb_info(ct,mev,npv)
write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',&
& ':',meu,npu,mev,npv
end block
info = 1
return
end if
base/tools/psb_z_remap.F90
+15 -2
View File
@@ -86,7 +86,6 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
endif
!!$ write(0,*) ' Remapping from ',np,' onto ', np_remap
mipd = ipd
if (desc_in%get_fmt() == 'BLOCK') then
!
! Should we spread the processes in the new context,
@@ -121,7 +120,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
goto 9999
endif
if (rnp >= np) then
write(0,*) ' No remapping on larger proc count now'
write(0,*) ' No remapping on larger proc count now',rnp,np
info = psb_err_internal_error_
call psb_errpush(info,name)
goto 9999
@@ -245,6 +244,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
else
naggr(me+1) = 0
end if
ipd = mipd
call psb_sum(ctxt,naggr)
end block
@@ -257,3 +257,16 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, &
return
end subroutine psb_z_remap
subroutine psb_z_remap2(map_in, desc_new, map_out, flag, info)
use psb_base_mod, psb_protect_name => psb_z_remap2
implicit none
!....parameters...
type(psb_desc_type), intent(inout) :: desc_new
type(psb_zlinmap_type), intent(inout) :: map_in
type(psb_zlinmap_type), intent(out) :: map_out
integer(psb_ipk_), intent(in) :: flag
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_remap2