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

Fix handling of tags for P2P and swap

Browse Source
pull/28/head
sfilippone 10 months ago
parent 4343a78afc
commit cdad04813b
1 changed files with 87 additions and 159 deletions
Show Stats Download Patch File Download Diff File

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

@ -49,7 +49,9 @@ module mpi
integer(psb_mpk_), parameter :: mpi_integer4 = 10 integer(psb_mpk_), parameter :: mpi_integer4 = 10
integer(psb_mpk_), parameter :: mpi_comm_null = -1 integer(psb_mpk_), parameter :: mpi_comm_null = -1
integer(psb_mpk_), parameter :: mpi_comm_world = 1 integer(psb_mpk_), parameter :: mpi_comm_world = 1
integer(psb_mpk_), parameter :: mpi_address_kind = psb_epk_
!real(psb_dpk_), external :: mpi_wtime !real(psb_dpk_), external :: mpi_wtime
interface interface
@ -179,44 +181,53 @@ end module mpi
module psi_penv_mod module psi_penv_mod
use psb_const_mod use psb_const_mod
use iso_c_binding use iso_c_binding
#ifdef PSB_MPI_MOD
integer(psb_mpk_), parameter:: psb_int_tag = 543987 use mpi
integer(psb_mpk_), parameter:: psb_real_tag = psb_int_tag + 1 #endif
integer(psb_mpk_), parameter:: psb_double_tag = psb_real_tag + 1 #ifdef PSB_MPI_H
integer(psb_mpk_), parameter:: psb_complex_tag = psb_double_tag + 1 include 'mpif.h'
integer(psb_mpk_), parameter:: psb_dcomplex_tag = psb_complex_tag + 1 #endif
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_apk_ = mpi_address_kind
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_tag_space = 200
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_), save :: psb_int_tag
integer(psb_mpk_), save :: psb_real_tag
integer(psb_mpk_), parameter:: psb_int_swap_tag = psb_int_tag + psb_int_tag integer(psb_mpk_), save :: psb_double_tag
integer(psb_mpk_), parameter:: psb_real_swap_tag = psb_real_tag + psb_int_tag integer(psb_mpk_), save :: psb_complex_tag
integer(psb_mpk_), parameter:: psb_double_swap_tag = psb_double_tag + psb_int_tag integer(psb_mpk_), save :: psb_dcomplex_tag
integer(psb_mpk_), parameter:: psb_complex_swap_tag = psb_complex_tag + psb_int_tag integer(psb_mpk_), save :: psb_logical_tag
integer(psb_mpk_), parameter:: psb_dcomplex_swap_tag = psb_dcomplex_tag + psb_int_tag integer(psb_mpk_), save :: psb_char_tag
integer(psb_mpk_), parameter:: psb_logical_swap_tag = psb_logical_tag + psb_int_tag integer(psb_mpk_), save :: psb_int8_tag
integer(psb_mpk_), parameter:: psb_char_swap_tag = psb_char_tag + psb_int_tag integer(psb_mpk_), save :: psb_int2_tag
integer(psb_mpk_), parameter:: psb_int8_swap_tag = psb_int8_tag + psb_int_tag integer(psb_mpk_), save :: psb_int4_tag
integer(psb_mpk_), parameter:: psb_int2_swap_tag = psb_int2_tag + psb_int_tag integer(psb_mpk_), save :: psb_long_tag
integer(psb_mpk_), parameter:: psb_int4_swap_tag = psb_int4_tag + psb_int_tag integer(psb_mpk_), save :: psb_max_simple_tag
integer(psb_mpk_), parameter:: psb_long_swap_tag = psb_long_tag + psb_int_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 = 987543 integer(psb_mpk_), private, parameter :: psb_int_type = 200
integer(psb_mpk_), private, parameter:: psb_real_type = psb_int_type + 1 integer(psb_mpk_), private, parameter :: psb_real_type = psb_int_type + 1
integer(psb_mpk_), private, parameter:: psb_double_type = psb_real_type + 1 integer(psb_mpk_), private, parameter :: psb_double_type = psb_real_type + 1
integer(psb_mpk_), private, parameter:: psb_complex_type = psb_double_type + 1 integer(psb_mpk_), private, parameter :: psb_complex_type = psb_double_type + 1
integer(psb_mpk_), private, parameter:: psb_dcomplex_type = psb_complex_type + 1 integer(psb_mpk_), private, parameter :: psb_dcomplex_type = psb_complex_type + 1
integer(psb_mpk_), private, parameter:: psb_logical_type = psb_dcomplex_type + 1 integer(psb_mpk_), private, parameter :: psb_logical_type = psb_dcomplex_type + 1
integer(psb_mpk_), private, parameter:: psb_char_type = psb_logical_type + 1 integer(psb_mpk_), private, parameter :: psb_char_type = psb_logical_type + 1
integer(psb_mpk_), private, parameter:: psb_int8_type = psb_char_type + 1 integer(psb_mpk_), private, parameter :: psb_int8_type = psb_char_type + 1
integer(psb_mpk_), private, parameter:: psb_int2_type = psb_int8_type + 1 integer(psb_mpk_), private, parameter :: psb_int2_type = psb_int8_type + 1
integer(psb_mpk_), private, parameter:: psb_int4_type = psb_int2_type + 1 integer(psb_mpk_), private, parameter :: psb_int4_type = psb_int2_type + 1
integer(psb_mpk_), private, parameter:: psb_long_type = psb_int4_type + 1 integer(psb_mpk_), private, parameter :: psb_long_type = psb_int4_type + 1
type psb_buffer_node type psb_buffer_node
integer(psb_mpk_) :: request integer(psb_mpk_) :: request
@ -304,7 +315,7 @@ module psi_penv_mod
#endif #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_i2amx_op, psi_i2amn_op
private :: psi_iamx_op, psi_iamn_op private :: psi_iamx_op, psi_iamn_op
private :: psi_mamx_op, psi_mamn_op private :: psi_mamx_op, psi_mamn_op
@ -341,13 +352,7 @@ contains
end subroutine psb_init_queue end subroutine psb_init_queue
subroutine psb_wait_buffer(node, info) subroutine psb_wait_buffer(node, info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_buffer_node), intent(inout) :: node type(psb_buffer_node), intent(inout) :: node
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_mpk_) :: status(mpi_status_size),minfo integer(psb_mpk_) :: status(mpi_status_size),minfo
@ -357,13 +362,7 @@ contains
end subroutine psb_wait_buffer end subroutine psb_wait_buffer
subroutine psb_test_buffer(node, flag, info) subroutine psb_test_buffer(node, flag, info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_buffer_node), intent(inout) :: node type(psb_buffer_node), intent(inout) :: node
logical, intent(out) :: flag logical, intent(out) :: flag
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
@ -476,13 +475,7 @@ contains
! !
! !!!!!!!!!!!!!!!!! ! !!!!!!!!!!!!!!!!!
subroutine psi_msnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_msnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
integer(psb_mpk_), allocatable, intent(inout) :: buffer(:) integer(psb_mpk_), allocatable, intent(inout) :: buffer(:)
@ -515,13 +508,7 @@ contains
subroutine psi_esnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_esnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
integer(psb_epk_), allocatable, intent(inout) :: buffer(:) integer(psb_epk_), allocatable, intent(inout) :: buffer(:)
@ -552,13 +539,7 @@ contains
end subroutine psi_esnd end subroutine psi_esnd
subroutine psi_i2snd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_i2snd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
integer(psb_i2pk_), allocatable, intent(inout) :: buffer(:) integer(psb_i2pk_), allocatable, intent(inout) :: buffer(:)
@ -589,13 +570,7 @@ contains
end subroutine psi_i2snd end subroutine psi_i2snd
subroutine psi_ssnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_ssnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
real(psb_spk_), allocatable, intent(inout) :: buffer(:) real(psb_spk_), allocatable, intent(inout) :: buffer(:)
@ -626,13 +601,7 @@ contains
end subroutine psi_ssnd end subroutine psi_ssnd
subroutine psi_dsnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_dsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
real(psb_dpk_), allocatable, intent(inout) :: buffer(:) real(psb_dpk_), allocatable, intent(inout) :: buffer(:)
@ -663,13 +632,7 @@ contains
end subroutine psi_dsnd end subroutine psi_dsnd
subroutine psi_csnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_csnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
complex(psb_spk_), allocatable, intent(inout) :: buffer(:) complex(psb_spk_), allocatable, intent(inout) :: buffer(:)
@ -700,13 +663,7 @@ contains
end subroutine psi_csnd end subroutine psi_csnd
subroutine psi_zsnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_zsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
complex(psb_dpk_), allocatable, intent(inout) :: buffer(:) complex(psb_dpk_), allocatable, intent(inout) :: buffer(:)
@ -738,13 +695,7 @@ contains
subroutine psi_logsnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_logsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
logical, allocatable, intent(inout) :: buffer(:) logical, allocatable, intent(inout) :: buffer(:)
@ -776,13 +727,7 @@ contains
subroutine psi_hsnd(ctxt,tag,dest,buffer,mesg_queue) subroutine psi_hsnd(ctxt,tag,dest,buffer,mesg_queue)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: tag, dest integer(psb_mpk_) :: tag, dest
character(len=1), allocatable, intent(inout) :: buffer(:) character(len=1), allocatable, intent(inout) :: buffer(:)
@ -850,16 +795,12 @@ contains
end subroutine psi_get_sizes end subroutine psi_get_sizes
subroutine psi_register_mpi_extras(info) subroutine psi_register_mpi_const(comm,info)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H integer(psb_mpk_) :: comm,info
include 'mpif.h' integer(psb_mpk_) :: ierror
#endif integer(psb_apk_) :: tag_value
integer(psb_mpk_) :: info logical :: flag
info = 0 info = 0
#if 0 #if 0
if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_ ,info) if (info == 0) call mpi_type_create_f90_integer(psb_ipk_, psb_mpi_ipk_ ,info)
@ -897,6 +838,7 @@ contains
#endif #endif
#if defined(PSB_SERIAL_MPI) #if defined(PSB_SERIAL_MPI)
tag_value = HUGE(psb_tag_space)/2
#else #else
if (info == 0) call mpi_op_create(psi_i2amx_op,.true.,mpi_i2amx_op,info) 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_i2amn_op,.true.,mpi_i2amn_op,info)
@ -914,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_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_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_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 #endif
psb_int_tag = tag_value - psb_tag_space
end subroutine psi_register_mpi_extras 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) #if (defined(PSB_IPK4) && defined(PSB_LPK8))||defined(PSB_IPK8)
subroutine psb_info_epk(ctxt,iam,np) subroutine psb_info_epk(ctxt,iam,np)
@ -941,13 +911,7 @@ contains
use psb_mat_mod use psb_mat_mod
use psb_vect_mod use psb_vect_mod
! !$ use psb_rsb_mod ! !$ use psb_rsb_mod
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(out) :: ctxt type(psb_ctxt_type), intent(out) :: ctxt
type(psb_ctxt_type), intent(in), optional :: basectxt type(psb_ctxt_type), intent(in), optional :: basectxt
integer(psb_mpk_), intent(in), optional :: np, ids(:), extcomm integer(psb_mpk_), intent(in), optional :: np, ids(:), extcomm
@ -965,7 +929,7 @@ contains
ctxt%ctxt = nctxt ! allocate on assignment ctxt%ctxt = nctxt ! allocate on assignment
nctxt = nctxt + 1 nctxt = nctxt + 1
call psi_register_mpi_extras(info) call psi_register_mpi_const(nctxt,info)
call psi_get_sizes() call psi_get_sizes()
#else #else
@ -1054,7 +1018,7 @@ contains
if (info == 0) then if (info == 0) then
ctxt%ctxt = icomm ! allocate on assignment ctxt%ctxt = icomm ! allocate on assignment
end if end if
call psi_register_mpi_extras(info) call psi_register_mpi_const(icomm,info)
call psi_get_sizes() call psi_get_sizes()
!if (ctxt == mpi_comm_null) return !if (ctxt == mpi_comm_null) return
if (.not.allocated(ctxt%ctxt)) return if (.not.allocated(ctxt%ctxt)) return
@ -1080,13 +1044,7 @@ contains
use psb_mat_mod use psb_mat_mod
use psb_vect_mod use psb_vect_mod
! !$ use psb_rsb_mod ! !$ use psb_rsb_mod
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(inout) :: ctxt type(psb_ctxt_type), intent(inout) :: ctxt
logical, intent(in), optional :: close logical, intent(in), optional :: close
logical :: close_ logical :: close_
@ -1154,13 +1112,7 @@ contains
subroutine psb_barrier_mpik(ctxt) subroutine psb_barrier_mpik(ctxt)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_) :: info integer(psb_mpk_) :: info
@ -1175,13 +1127,7 @@ contains
function psb_wtime() function psb_wtime()
use psb_const_mod use psb_const_mod
! use mpi_constants ! use mpi_constants
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
real(psb_dpk_) :: psb_wtime real(psb_dpk_) :: psb_wtime
psb_wtime = mpi_wtime() psb_wtime = mpi_wtime()
@ -1210,13 +1156,7 @@ contains
subroutine psb_info_mpik(ctxt,iam,np) subroutine psb_info_mpik(ctxt,iam,np)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type), intent(in) :: ctxt type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_mpk_), intent(out) :: iam, np integer(psb_mpk_), intent(out) :: iam, np
@ -1269,13 +1209,7 @@ contains
function psb_m_get_mpi_comm(ctxt) result(comm) function psb_m_get_mpi_comm(ctxt) result(comm)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: comm integer(psb_mpk_) :: comm
comm = mpi_comm_null comm = mpi_comm_null
@ -1291,13 +1225,7 @@ contains
end function psb_m_get_mpi_rank end function psb_m_get_mpi_rank
subroutine psb_get_mpicomm(ctxt,comm) subroutine psb_get_mpicomm(ctxt,comm)
#ifdef PSB_MPI_MOD
use mpi
#endif
implicit none implicit none
#ifdef PSB_MPI_H
include 'mpif.h'
#endif
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
integer(psb_mpk_) :: comm integer(psb_mpk_) :: comm
comm = mpi_comm_null comm = mpi_comm_null

Write Preview
Loading…
Cancel
Save