fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Use mpi_comm_get_attr to set tag values

Browse Source
pull/28/head
sfilippone 8 months ago
parent 0d69cdb005
commit 42b8daae8c
1 changed files with 64 additions and 34 deletions
Show Stats Download Patch File Download Diff File

98
base/modules/penv/psi_penv_mod.F90
Unescape Escape View File

@ -189,33 +189,32 @@ module psi_penv_mod
#endif
integer(psb_mpk_), parameter :: psb_apk_ = mpi_address_kind
integer(psb_mpk_), parameter :: psb_int_tag = 100
integer(psb_mpk_), parameter :: psb_real_tag = psb_int_tag + 1
integer(psb_mpk_), parameter :: psb_double_tag = psb_real_tag + 1
integer(psb_mpk_), parameter :: psb_complex_tag = psb_double_tag + 1
integer(psb_mpk_), parameter :: psb_dcomplex_tag = psb_complex_tag + 1
integer(psb_mpk_), parameter :: psb_logical_tag = psb_dcomplex_tag + 1
integer(psb_mpk_), parameter :: psb_char_tag = psb_logical_tag + 1
integer(psb_mpk_), parameter :: psb_int8_tag = psb_char_tag + 1
integer(psb_mpk_), parameter :: psb_int2_tag = psb_int8_tag + 1
integer(psb_mpk_), parameter :: psb_int4_tag = psb_int2_tag + 1
integer(psb_mpk_), parameter :: psb_long_tag = psb_int4_tag + 1
integer(psb_mpk_), parameter :: psb_max_simple_tag = psb_long_tag + 2
integer(psb_mpk_), parameter :: psb_int_swap_tag = psb_max_simple_tag + 1
integer(psb_mpk_), parameter :: psb_real_swap_tag = psb_int_swap_tag + 1
integer(psb_mpk_), parameter :: psb_double_swap_tag = psb_real_swap_tag + 1
integer(psb_mpk_), parameter :: psb_complex_swap_tag = psb_double_swap_tag + 1
integer(psb_mpk_), parameter :: psb_dcomplex_swap_tag = psb_complex_swap_tag + 1
integer(psb_mpk_), parameter :: psb_logical_swap_tag = psb_dcomplex_swap_tag + 1
integer(psb_mpk_), parameter :: psb_char_swap_tag = psb_logical_swap_tag + 1
integer(psb_mpk_), parameter :: psb_int8_swap_tag = psb_char_swap_tag + 1
integer(psb_mpk_), parameter :: psb_int2_swap_tag = psb_int8_swap_tag + 1
integer(psb_mpk_), parameter :: psb_int4_swap_tag = psb_int2_swap_tag + 1
integer(psb_mpk_), parameter :: psb_long_swap_tag = psb_int4_swap_tag + 1
integer(psb_mpk_), parameter :: psb_tag_space = 200
integer(psb_mpk_), save :: psb_int_tag
integer(psb_mpk_), save :: psb_real_tag
integer(psb_mpk_), save :: psb_double_tag
integer(psb_mpk_), save :: psb_complex_tag
integer(psb_mpk_), save :: psb_dcomplex_tag
integer(psb_mpk_), save :: psb_logical_tag
integer(psb_mpk_), save :: psb_char_tag
integer(psb_mpk_), save :: psb_int8_tag
integer(psb_mpk_), save :: psb_int2_tag
integer(psb_mpk_), save :: psb_int4_tag
integer(psb_mpk_), save :: psb_long_tag
integer(psb_mpk_), save :: psb_max_simple_tag
integer(psb_mpk_), save :: psb_int_swap_tag
integer(psb_mpk_), save :: psb_real_swap_tag
integer(psb_mpk_), save :: psb_double_swap_tag
integer(psb_mpk_), save :: psb_complex_swap_tag
integer(psb_mpk_), save :: psb_dcomplex_swap_tag
integer(psb_mpk_), save :: psb_logical_swap_tag
integer(psb_mpk_), save :: psb_char_swap_tag
integer(psb_mpk_), save :: psb_int8_swap_tag
integer(psb_mpk_), save :: psb_int2_swap_tag
integer(psb_mpk_), save :: psb_int4_swap_tag
integer(psb_mpk_), save :: psb_long_swap_tag
integer(psb_mpk_), private, parameter :: psb_int_type = 200
@ -316,7 +315,7 @@ module psi_penv_mod
#endif
private :: psi_get_sizes, psi_register_mpi_extras
private :: psi_get_sizes, psi_register_mpi_const
private :: psi_i2amx_op, psi_i2amn_op
private :: psi_iamx_op, psi_iamn_op
private :: psi_mamx_op, psi_mamn_op
@ -796,10 +795,12 @@ contains
end subroutine psi_get_sizes
subroutine psi_register_mpi_extras(info)
subroutine psi_register_mpi_const(comm,info)
implicit none
integer(psb_mpk_) :: info
integer(psb_mpk_) :: comm,info
integer(psb_mpk_) :: ierror
integer(psb_apk_) :: tag_value
logical :: flag
info = 0
#if 0
if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_ ,info)
@ -837,6 +838,7 @@ contains
#endif
#if defined(PSB_SERIAL_MPI)
tag_value = HUGE(psb_tag_space)/2
#else
if (info == 0) call mpi_op_create(psi_i2amx_op,.true.,mpi_i2amx_op,info)
if (info == 0) call mpi_op_create(psi_i2amn_op,.true.,mpi_i2amn_op,info)
@ -854,9 +856,37 @@ contains
if (info == 0) call mpi_op_create(psi_zamn_op,.true.,mpi_zamn_op,info)
if (info == 0) call mpi_op_create(psi_snrm2_op,.true.,mpi_snrm2_op,info)
if (info == 0) call mpi_op_create(psi_dnrm2_op,.true.,mpi_dnrm2_op,info)
if (info == 0) call mpi_comm_get_attr(comm,mpi_tag_ub,tag_value,flag,ierror)
if ((ierror/=0).or.(.not.flag)) then
tag_value = 0
info = psb_err_internal_error_
end if
#endif
end subroutine psi_register_mpi_extras
psb_int_tag = tag_value - psb_tag_space
psb_real_tag = psb_int_tag + 1
psb_double_tag = psb_real_tag + 1
psb_complex_tag = psb_double_tag + 1
psb_dcomplex_tag = psb_complex_tag + 1
psb_logical_tag = psb_dcomplex_tag + 1
psb_char_tag = psb_logical_tag + 1
psb_int8_tag = psb_char_tag + 1
psb_int2_tag = psb_int8_tag + 1
psb_int4_tag = psb_int2_tag + 1
psb_long_tag = psb_int4_tag + 1
psb_max_simple_tag = psb_long_tag + 2
psb_int_swap_tag = psb_max_simple_tag + 1
psb_real_swap_tag = psb_int_swap_tag + 1
psb_double_swap_tag = psb_real_swap_tag + 1
psb_complex_swap_tag = psb_double_swap_tag + 1
psb_dcomplex_swap_tag = psb_complex_swap_tag + 1
psb_logical_swap_tag = psb_dcomplex_swap_tag + 1
psb_char_swap_tag = psb_logical_swap_tag + 1
psb_int8_swap_tag = psb_char_swap_tag + 1
psb_int2_swap_tag = psb_int8_swap_tag + 1
psb_int4_swap_tag = psb_int2_swap_tag + 1
psb_long_swap_tag = psb_int4_swap_tag + 1
end subroutine psi_register_mpi_const
#if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8)
subroutine psb_info_epk(ctxt,iam,np)
@ -899,7 +929,7 @@ contains
ctxt%ctxt = nctxt ! allocate on assignment
nctxt = nctxt + 1
call psi_register_mpi_extras(info)
call psi_register_mpi_const(nctxt,info)
call psi_get_sizes()
#else
@ -988,7 +1018,7 @@ contains
if (info == 0) then
ctxt%ctxt = icomm ! allocate on assignment
end if
call psi_register_mpi_extras(info)
call psi_register_mpi_const(icomm,info)
call psi_get_sizes()
!if (ctxt == mpi_comm_null) return
if (.not.allocated(ctxt%ctxt)) return

Write Preview
Loading…
Cancel
Save