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

Enable I2 send/receive/collectives

Browse Source
This commit is contained in:
sfilippone
2024-11-25 12:35:39 +01:00
parent 7e73900703
commit fa6b8d5e33
3 changed files with 29 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/Makefile
+2 -1
View File
@@ -10,13 +10,14 @@ BASIC_MODS= psb_const_mod.o psb_cbind_const_mod.o psb_error_mod.o psb_realloc_mo
auxil/psb_z_realloc_mod.o
COMMINT= penv/psi_penv_mod.o \
penv/psi_p2p_mod.o penv/psi_m_p2p_mod.o \
penv/psi_p2p_mod.o penv/psi_m_p2p_mod.o penv/psi_i2_p2p_mod.o \
penv/psi_e_p2p_mod.o \
penv/psi_s_p2p_mod.o \
penv/psi_d_p2p_mod.o \
penv/psi_c_p2p_mod.o \
penv/psi_z_p2p_mod.o \
penv/psi_collective_mod.o \
penv/psi_i2_collective_mod.o \
penv/psi_e_collective_mod.o \
penv/psi_m_collective_mod.o \
penv/psi_s_collective_mod.o \
base/modules/desc/psb_desc_const_mod.f90
+1 -1
View File
@@ -35,7 +35,7 @@
! Auxiliary module for descriptor: constant values.
!
module psb_desc_const_mod
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_
use psb_const_mod, only : psb_ipk_, psb_lpk_, psb_mpk_, psb_epk_, psb_i2pk_
!
! Communication, prolongation & restriction
!
base/modules/penv/psi_penv_mod.F90
+26
View File
@@ -167,6 +167,7 @@ module psi_penv_mod
#else
integer(psb_mpk_), save :: mpi_i2amx_op, mpi_i2amn_op
integer(psb_mpk_), save :: mpi_iamx_op, mpi_iamn_op
integer(psb_mpk_), save :: mpi_mamx_op, mpi_mamn_op
integer(psb_mpk_), save :: mpi_eamx_op, mpi_eamn_op
@@ -181,6 +182,7 @@ module psi_penv_mod
#endif
private :: psi_get_sizes, psi_register_mpi_extras
private :: psi_i2amx_op, psi_i2amn_op
private :: psi_iamx_op, psi_iamn_op
private :: psi_mamx_op, psi_mamn_op
private :: psi_eamx_op, psi_eamn_op
@@ -773,6 +775,8 @@ contains
#if defined(SERIAL_MPI)
#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)
if (info == 0) call mpi_op_create(psi_mamx_op,.true.,mpi_mamx_op,info)
if (info == 0) call mpi_op_create(psi_mamn_op,.true.,mpi_mamn_op,info)
if (info == 0) call mpi_op_create(psi_eamx_op,.true.,mpi_eamx_op,info)
@@ -997,6 +1001,8 @@ contains
& call mpi_comm_Free(ctxt%ctxt,info)
end if
if (close_) then
if (info == 0) call mpi_op_free(mpi_i2amx_op,info)
if (info == 0) call mpi_op_free(mpi_i2amn_op,info)
if (info == 0) call mpi_op_free(mpi_mamx_op,info)
if (info == 0) call mpi_op_free(mpi_mamn_op,info)
if (info == 0) call mpi_op_free(mpi_eamx_op,info)
@@ -1188,6 +1194,26 @@ contains
! Note: len & type are always default integer.
!
! !!!!!!!!!!!!!!!!!!!!!!
subroutine psi_i2amx_op(inv, outv,len,type)
integer(psb_i2pk_) :: inv(len), outv(len)
integer(psb_mpk_) :: len,type
integer(psb_mpk_) :: i
do i=1, len
if (abs(inv(i)) > abs(outv(i))) outv(i) = inv(i)
end do
end subroutine psi_i2amx_op
subroutine psi_i2amn_op(inv, outv,len,type)
integer(psb_i2pk_) :: inv(len), outv(len)
integer(psb_mpk_) :: len,type
integer(psb_mpk_) :: i
do i=1, len
if (abs(inv(i)) < abs(outv(i))) outv(i) = inv(i)
end do
end subroutine psi_i2amn_op
subroutine psi_mamx_op(inv, outv,len,type)
integer(psb_mpk_) :: inv(len), outv(len)
integer(psb_mpk_) :: len,type