August 2014 - commits - mailman3.cels.anl.gov

[mpich] MPICH primary repository branch, master, updated. v3.1.2-118-gffa9c6d
by noreply＠mpich.org 26 Aug '14

26 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via ffa9c6d675c8463f903aa0b186f883f7c5cd218f (commit) from c5c26b1bf2e045318460319d70d265ec75e6d3fd (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/ffa9c6d675c8463f903aa0b186f883f7c… commit ffa9c6d675c8463f903aa0b186f883f7c5cd218f Author: Pavan Balaji <balaji(a)anl.gov> Date: Tue Aug 26 11:28:26 2014 -0500 Missed including pmi.h in mxm_impl.h Signed-off-by: Devendar Bureddy <devendar(a)mellanox.com> diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h index 3d5f5d4..54d5833 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h @@ -9,6 +9,7 @@ #ifndef MX_MODULE_IMPL_H #define MX_MODULE_IMPL_H #include "mpid_nem_impl.h" +#include "pmi.h" #include <mxm/api/mxm_api.h> ----------------------------------------------------------------------- Summary of changes: .../ch3/channels/nemesis/netmod/mxm/mxm_impl.h | 1 + 1 files changed, 1 insertions(+), 0 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-117-gc5c26b1
by noreply＠mpich.org 26 Aug '14

26 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via c5c26b1bf2e045318460319d70d265ec75e6d3fd (commit) via 765f0a299e2c38dec805278653433ba2eef9e354 (commit) from c13ab18f22de8df22b97f51dfa9aeede53cc5ab5 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/c5c26b1bf2e045318460319d70d265ec7… commit c5c26b1bf2e045318460319d70d265ec75e6d3fd Author: Pavan Balaji <balaji(a)anl.gov> Date: Mon Aug 25 17:05:23 2014 -0500 Mellanox patch for a netmod-specific communicator context. Move device specific comm structure components to 'dev'. Move channel-specific code into a different channel structure. The context stores MXM-specific information for sending/receiving data. Signed-off-by: Devendar Bureddy <devendar(a)mellanox.com> diff --git a/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h b/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h index 57e6230..8289043 100644 --- a/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h +++ b/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h @@ -31,6 +31,7 @@ typedef struct { struct MPID_nem_barrier_vars *barrier_vars; /* shared memory variables used in barrier */ + void *netmod_priv; /* netmod communicator private data */ } MPIDI_CH3I_CH_comm_t; typedef enum MPIDI_CH3I_VC_state diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c index 13b4a5a..44283d7 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c @@ -584,7 +584,7 @@ static int _mxm_add_comm(MPID_Comm * comm, void *param) mpi_errno, MPI_ERR_OTHER, "**mxm_mq_create", "**mxm_mq_create %s", mxm_error_string(ret)); - comm->ch.netmod_comm = (void *) mxm_mq; + comm->dev.ch.netmod_priv = (void *) mxm_mq; fn_exit: return mpi_errno; @@ -595,7 +595,7 @@ static int _mxm_add_comm(MPID_Comm * comm, void *param) static int _mxm_del_comm(MPID_Comm * comm, void *param) { int mpi_errno = MPI_SUCCESS; - mxm_mq_h mxm_mq = (mxm_mq_h) comm->ch.netmod_comm; + mxm_mq_h mxm_mq = (mxm_mq_h) comm->dev.ch.netmod_priv; _dbg_mxm_output(6, "Del COMM comm %p (context %d rank %d) \n", comm, comm->context_id, comm->rank); @@ -603,7 +603,7 @@ static int _mxm_del_comm(MPID_Comm * comm, void *param) if (mxm_mq) mxm_mq_destroy(mxm_mq); - comm->ch.netmod_comm = NULL; + comm->dev.ch.netmod_priv = NULL; fn_exit: return mpi_errno; diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_poll.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_poll.c index df6fa59..eef92ee 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_poll.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_poll.c @@ -198,7 +198,7 @@ int MPID_nem_mxm_recv(MPIDI_VC_t * vc, MPID_Request * rreq) mpi_errno = _mxm_irecv((vc ? VC_FIELD(vc, mxm_ep) : NULL), REQ_BASE(rreq), tag, - (rreq->comm ? (mxm_mq_h) rreq->comm->ch.netmod_comm : mxm_obj-> + (rreq->comm ? (mxm_mq_h) rreq->comm->dev.ch.netmod_priv : mxm_obj-> mxm_mq), _mxm_tag_mpi2mxm(tag, context_id)); if (mpi_errno) MPIU_ERR_POP(mpi_errno); diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_probe.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_probe.c index a03d410..001908a 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_probe.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_probe.c @@ -24,7 +24,7 @@ int MPID_nem_mxm_probe(MPIDI_VC_t * vc, int source, int tag, MPID_Comm * comm, i MPIDI_FUNC_ENTER(MPID_STATE_MXM_PROBE); mxm_req.base.state = MXM_REQ_NEW; - mxm_req.base.mq = (mxm_mq_h) comm->ch.netmod_comm; + mxm_req.base.mq = (mxm_mq_h) comm->dev.ch.netmod_priv; mxm_req.base.conn = (vc ? VC_FIELD(vc, mxm_ep->mxm_conn) : 0); mxm_req.tag = _mxm_tag_mpi2mxm(tag, comm->context_id + context_offset); @@ -68,7 +68,7 @@ int MPID_nem_mxm_iprobe(MPIDI_VC_t * vc, int source, int tag, MPID_Comm * comm, MPIDI_FUNC_ENTER(MPID_STATE_MXM_IPROBE); mxm_req.base.state = MXM_REQ_NEW; - mxm_req.base.mq = (mxm_mq_h) comm->ch.netmod_comm; + mxm_req.base.mq = (mxm_mq_h) comm->dev.ch.netmod_priv; mxm_req.base.conn = (vc ? VC_FIELD(vc, mxm_ep->mxm_conn) : 0); mxm_req.tag = _mxm_tag_mpi2mxm(tag, comm->context_id + context_offset); diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c index 5371625..6a6a9a3 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c @@ -274,7 +274,7 @@ int MPID_nem_mxm_send(MPIDI_VC_t * vc, const void *buf, int count, MPI_Datatype (VC_FIELD(vc, pending_sends)) += 1; mpi_errno = _mxm_isend(VC_FIELD(vc, mxm_ep), REQ_BASE(sreq), MXM_MPICH_ISEND, - (mxm_mq_h) comm->ch.netmod_comm, comm->rank, tag, _mxm_tag_mpi2mxm(tag, + (mxm_mq_h) comm->dev.ch.netmod_priv, comm->rank, tag, _mxm_tag_mpi2mxm(tag, comm->context_id + context_offset), @@ -371,7 +371,7 @@ int MPID_nem_mxm_ssend(MPIDI_VC_t * vc, const void *buf, int count, MPI_Datatype (VC_FIELD(vc, pending_sends)) += 1; mpi_errno = _mxm_isend(VC_FIELD(vc, mxm_ep), REQ_BASE(sreq), MXM_MPICH_ISEND_SYNC, - (mxm_mq_h) comm->ch.netmod_comm, comm->rank, tag, _mxm_tag_mpi2mxm(tag, + (mxm_mq_h) comm->dev.ch.netmod_priv, comm->rank, tag, _mxm_tag_mpi2mxm(tag, comm->context_id + context_offset), @@ -468,7 +468,7 @@ int MPID_nem_mxm_isend(MPIDI_VC_t * vc, const void *buf, int count, MPI_Datatype (VC_FIELD(vc, pending_sends)) += 1; mpi_errno = _mxm_isend(VC_FIELD(vc, mxm_ep), REQ_BASE(sreq), MXM_MPICH_ISEND, - (mxm_mq_h) comm->ch.netmod_comm, comm->rank, tag, _mxm_tag_mpi2mxm(tag, + (mxm_mq_h) comm->dev.ch.netmod_priv, comm->rank, tag, _mxm_tag_mpi2mxm(tag, comm->context_id + context_offset), @@ -566,7 +566,7 @@ int MPID_nem_mxm_issend(MPIDI_VC_t * vc, const void *buf, int count, MPI_Datatyp (VC_FIELD(vc, pending_sends)) += 1; mpi_errno = _mxm_isend(VC_FIELD(vc, mxm_ep), REQ_BASE(sreq), MXM_MPICH_ISEND_SYNC, - (mxm_mq_h) comm->ch.netmod_comm, comm->rank, tag, _mxm_tag_mpi2mxm(tag, + (mxm_mq_h) comm->dev.ch.netmod_priv, comm->rank, tag, _mxm_tag_mpi2mxm(tag, comm->context_id + context_offset), http://git.mpich.org/mpich.git/commitdiff/765f0a299e2c38dec805278653433ba2e… commit 765f0a299e2c38dec805278653433ba2eef9e354 Author: Pavan Balaji <balaji(a)anl.gov> Date: Mon Aug 25 13:55:28 2014 -0500 Use CVARS instead of env in the MXM netmod. The mxm netmod was using getenv directly instead of going through the CVAR interface. This disallows users from controlling it through MPI_T. Signed-off-by: Devendar Bureddy <devendar(a)mellanox.com> diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c index eafe66a..13b4a5a 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c @@ -14,6 +14,36 @@ #include "mpid_nem_impl.h" #include "mxm_impl.h" +/* +=== BEGIN_MPI_T_CVAR_INFO_BLOCK === + +cvars: + - name : MPIR_CVAR_NEMESIS_MXM_BULK_CONNECT + category : CH3 + type : boolean + default : false + class : none + verbosity : MPI_T_VERBOSITY_USER_BASIC + scope : MPI_T_SCOPE_ALL_EQ + description : >- + If true, force mxm to connect all processes at initialization + time. + + - name : MPIR_CVAR_NEMESIS_MXM_BULK_DISCONNECT + category : CH3 + type : boolean + default : false + class : none + verbosity : MPI_T_VERBOSITY_USER_BASIC + scope : MPI_T_SCOPE_ALL_EQ + description : >- + If true, force mxm to disconnect all processes at + finalization time. + +=== END_MPI_T_CVAR_INFO_BLOCK === +*/ + + MPID_nem_netmod_funcs_t MPIDI_nem_mxm_funcs = { MPID_nem_mxm_init, MPID_nem_mxm_finalize, @@ -362,11 +392,9 @@ static int _mxm_conf(void) "%ld.%ld", (cur_ver >> MXM_MAJOR_BIT) & 0xff, (cur_ver >> MXM_MINOR_BIT) & 0xff); #endif - env_val = getenv("MPICH_NETMOD_MXM_BULK_CONNECT"); - _mxm_obj.conf.bulk_connect = (env_val ? atoi(env_val) : (cur_ver < MXM_VERSION(3, 2) ? 0 : 1)); - env_val = getenv("MPICH_NETMOD_MXM_BULK_DISCONNECT"); - _mxm_obj.conf.bulk_disconnect = (env_val ? - atoi(env_val) : (cur_ver < MXM_VERSION(3, 2) ? 0 : 1)); + _mxm_obj.conf.bulk_connect = cur_ver < MXM_VERSION(3, 2) ? 0 : MPIR_CVAR_NEMESIS_MXM_BULK_CONNECT; + _mxm_obj.conf.bulk_disconnect = cur_ver < MXM_VERSION(3, 2) ? 0 : MPIR_CVAR_NEMESIS_MXM_BULK_DISCONNECT; + if (cur_ver < MXM_VERSION(3, 2) && (_mxm_obj.conf.bulk_connect || _mxm_obj.conf.bulk_disconnect)) { _mxm_obj.conf.bulk_connect = 0; ----------------------------------------------------------------------- Summary of changes: .../ch3/channels/nemesis/include/mpidi_ch3_pre.h | 1 + .../ch3/channels/nemesis/netmod/mxm/mxm_init.c | 44 ++++++++++++++++---- .../ch3/channels/nemesis/netmod/mxm/mxm_poll.c | 2 +- .../ch3/channels/nemesis/netmod/mxm/mxm_probe.c | 4 +- .../ch3/channels/nemesis/netmod/mxm/mxm_send.c | 8 ++-- 5 files changed, 44 insertions(+), 15 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-115-gc13ab18
by noreply＠mpich.org 26 Aug '14

26 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via c13ab18f22de8df22b97f51dfa9aeede53cc5ab5 (commit) from bbacb5b5be1182924cd50416e7a05033e3a145dd (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/c13ab18f22de8df22b97f51dfa9aeede5… commit c13ab18f22de8df22b97f51dfa9aeede53cc5ab5 Author: Pavan Balaji <balaji(a)anl.gov> Date: Mon Aug 25 17:05:23 2014 -0500 Move channel specific code into a separate channel structure. Also move device specific comm structure components to 'dev' to clean up the naming a bit. Signed-off-by: Ken Raffenetti <raffenet(a)mcs.anl.gov> diff --git a/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h b/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h index 1fa883b..57e6230 100644 --- a/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h +++ b/src/mpid/ch3/channels/nemesis/include/mpidi_ch3_pre.h @@ -28,6 +28,10 @@ MPIDI_NEM_PKT_LMT_COOKIE, \ MPIDI_NEM_PKT_CKPT_MARKER, \ MPIDI_NEM_PKT_NETMOD + +typedef struct { + struct MPID_nem_barrier_vars *barrier_vars; /* shared memory variables used in barrier */ +} MPIDI_CH3I_CH_comm_t; typedef enum MPIDI_CH3I_VC_state { diff --git a/src/mpid/ch3/channels/nemesis/src/ch3i_comm.c b/src/mpid/ch3/channels/nemesis/src/ch3i_comm.c index ec4ce5f..ebddf1d 100644 --- a/src/mpid/ch3/channels/nemesis/src/ch3i_comm.c +++ b/src/mpid/ch3/channels/nemesis/src/ch3i_comm.c @@ -35,7 +35,7 @@ int MPIDI_CH3I_comm_create(MPID_Comm *comm, void *param) /* set up intranode barrier iff this is an intranode communicator */ if (comm->hierarchy_kind == MPID_HIERARCHY_NODE) { MPID_Collops *cf, **cf_p; - comm->ch.barrier_vars = NULL; + comm->dev.ch.barrier_vars = NULL; /* We can't use a static coll_fns override table for our collectives because we store a pointer to the previous coll_fns in our coll_fns @@ -109,9 +109,9 @@ int MPIDI_CH3I_comm_destroy(MPID_Comm *comm, void *param) MPIU_Free(cf); } - if (comm->ch.barrier_vars && OPA_fetch_and_decr_int(&comm->ch.barrier_vars->usage_cnt) == 1) { + if (comm->dev.ch.barrier_vars && OPA_fetch_and_decr_int(&comm->dev.ch.barrier_vars->usage_cnt) == 1) { OPA_write_barrier(); - OPA_store_int(&comm->ch.barrier_vars->context_id, NULL_CONTEXT_ID); + OPA_store_int(&comm->dev.ch.barrier_vars->context_id, NULL_CONTEXT_ID); } } @@ -178,11 +178,11 @@ static int barrier(MPID_Comm *comm_ptr, int *errflag) time */ MPIDU_ERR_CHECK_MULTIPLE_THREADS_ENTER (comm_ptr); - if (comm_ptr->ch.barrier_vars == NULL) { - mpi_errno = alloc_barrier_vars (comm_ptr, &comm_ptr->ch.barrier_vars); + if (comm_ptr->dev.ch.barrier_vars == NULL) { + mpi_errno = alloc_barrier_vars (comm_ptr, &comm_ptr->dev.ch.barrier_vars); if (mpi_errno) MPIU_ERR_POP (mpi_errno); - if (comm_ptr->ch.barrier_vars == NULL) { + if (comm_ptr->dev.ch.barrier_vars == NULL) { /* no barrier_vars left -- revert to default barrier. */ /* FIXME: need a better solution here. e.g., allocate some barrier_vars on the first barrier for the life of @@ -201,7 +201,7 @@ static int barrier(MPID_Comm *comm_ptr, int *errflag) } } - barrier_vars = comm_ptr->ch.barrier_vars; + barrier_vars = comm_ptr->dev.ch.barrier_vars; sense = OPA_load_int(&barrier_vars->sig); OPA_read_barrier(); diff --git a/src/mpid/ch3/channels/sock/include/mpidi_ch3_pre.h b/src/mpid/ch3/channels/sock/include/mpidi_ch3_pre.h index c86c849..c0d43ad 100644 --- a/src/mpid/ch3/channels/sock/include/mpidi_ch3_pre.h +++ b/src/mpid/ch3/channels/sock/include/mpidi_ch3_pre.h @@ -28,6 +28,10 @@ MPIDI_CH3I_PKT_SC_CONN_ACCEPT, \ MPIDI_CH3I_PKT_SC_OPEN_RESP, \ MPIDI_CH3I_PKT_SC_CLOSE +typedef struct { + int dummy; /* dummy variable to ensure we don't have an empty structure */ +} MPIDI_CH3I_CH_comm_t; + /* This channel has no special channel data for the process group structure */ /* FIXME: Explain these; why is this separate from the VC state? */ diff --git a/src/mpid/ch3/include/mpidimpl.h b/src/mpid/ch3/include/mpidimpl.h index b6ee2ef..cbeeaf8 100644 --- a/src/mpid/ch3/include/mpidimpl.h +++ b/src/mpid/ch3/include/mpidimpl.h @@ -1961,8 +1961,8 @@ int MPIDI_CH3_ReqHandler_GetSendRespComplete( MPIDI_VC_t *, MPID_Request *, #define MPIDI_CH3_GET_EAGER_THRESHOLD(eager_threshold_p, comm, vc) \ do { \ - if ((comm)->ch.eager_max_msg_sz != -1) \ - *(eager_threshold_p) = (comm)->ch.eager_max_msg_sz; \ + if ((comm)->dev.eager_max_msg_sz != -1) \ + *(eager_threshold_p) = (comm)->dev.eager_max_msg_sz; \ else \ *(eager_threshold_p) = (vc)->eager_max_msg_sz; \ } while (0) diff --git a/src/mpid/ch3/include/mpidpre.h b/src/mpid/ch3/include/mpidpre.h index 13d9544..76ef00f 100644 --- a/src/mpid/ch3/include/mpidpre.h +++ b/src/mpid/ch3/include/mpidpre.h @@ -166,7 +166,7 @@ typedef union { #define MPID_Dev_comm_create_hook(comm_) MPIDI_CH3I_Comm_create_hook(comm_) #define MPID_Dev_comm_destroy_hook(comm_) MPIDI_CH3I_Comm_destroy_hook(comm_) -#define MPIDI_CH3I_Comm_AS_enabled(comm) ((comm)->ch.anysource_enabled) +#define MPIDI_CH3I_Comm_AS_enabled(comm) ((comm)->dev.anysource_enabled) typedef struct MPIDI_CH3I_comm { @@ -176,13 +176,13 @@ typedef struct MPIDI_CH3I_comm int waiting_for_revoke; /* The number of other processes from which we are * waiting for a revoke message before we can release * the context id */ - struct MPID_nem_barrier_vars *barrier_vars; /* shared memory variables used in barrier */ struct MPID_Comm *next; /* next pointer for list of communicators */ struct MPID_Comm *prev; /* prev pointer for list of communicators */ + MPIDI_CH3I_CH_comm_t ch; } MPIDI_CH3I_comm_t; -#define MPID_DEV_COMM_DECL MPIDI_CH3I_comm_t ch; +#define MPID_DEV_COMM_DECL MPIDI_CH3I_comm_t dev; #ifndef HAVE_MPIDI_VCRT #define HAVE_MPIDI_VCRT diff --git a/src/mpid/ch3/src/ch3u_comm.c b/src/mpid/ch3/src/ch3u_comm.c index 871b1f2..0ceb952 100644 --- a/src/mpid/ch3/src/ch3u_comm.c +++ b/src/mpid/ch3/src/ch3u_comm.c @@ -12,9 +12,9 @@ static int comm_created(MPID_Comm *comm, void *param); static int comm_destroyed(MPID_Comm *comm, void *param); /* macros and head for list of communicators */ -#define COMM_ADD(comm) MPL_DL_PREPEND_NP(comm_list, comm, ch.next, ch.prev) -#define COMM_DEL(comm) MPL_DL_DELETE_NP(comm_list, comm, ch.next, ch.prev) -#define COMM_FOREACH(elt) MPL_DL_FOREACH_NP(comm_list, elt, ch.next, ch.prev) +#define COMM_ADD(comm) MPL_DL_PREPEND_NP(comm_list, comm, dev.next, dev.prev) +#define COMM_DEL(comm) MPL_DL_DELETE_NP(comm_list, comm, dev.next, dev.prev) +#define COMM_FOREACH(elt) MPL_DL_FOREACH_NP(comm_list, elt, dev.next, dev.prev) static MPID_Comm *comm_list = NULL; typedef struct hook_elt @@ -203,13 +203,13 @@ int comm_created(MPID_Comm *comm, void *param) MPIDI_FUNC_ENTER(MPID_STATE_COMM_CREATED); - comm->ch.anysource_enabled = TRUE; + comm->dev.anysource_enabled = TRUE; /* Use the VC's eager threshold by default. */ - comm->ch.eager_max_msg_sz = -1; + comm->dev.eager_max_msg_sz = -1; /* Initialize the last acked failure to -1 */ - comm->ch.last_ack_rank = -1; + comm->dev.last_ack_rank = -1; COMM_ADD(comm); @@ -232,8 +232,8 @@ int comm_destroyed(MPID_Comm *comm, void *param) MPIDI_FUNC_ENTER(MPID_STATE_COMM_DESTROYED); COMM_DEL(comm); - comm->ch.next = NULL; - comm->ch.prev = NULL; + comm->dev.next = NULL; + comm->dev.prev = NULL; fn_exit: MPIDI_FUNC_EXIT(MPID_STATE_COMM_DESTROYED); @@ -307,7 +307,7 @@ int MPIDI_CH3I_Comm_handle_failed_procs(MPID_Group *new_failed_procs) COMM_FOREACH(comm) { /* if this comm is already collectively inactive and anysources are disabled, there's no need to check */ - if (!comm->ch.anysource_enabled) + if (!comm->dev.anysource_enabled) continue; mpi_errno = nonempty_intersection(comm, new_failed_procs, &flag); @@ -317,7 +317,7 @@ int MPIDI_CH3I_Comm_handle_failed_procs(MPID_Group *new_failed_procs) MPIU_DBG_MSG_FMT(CH3_OTHER, VERBOSE, (MPIU_DBG_FDEST, "disabling AS on communicator %p (%#08x)", comm, comm->handle)); - comm->ch.anysource_enabled = FALSE; + comm->dev.anysource_enabled = FALSE; } } diff --git a/src/mpid/ch3/src/mpid_comm_failure_ack.c b/src/mpid/ch3/src/mpid_comm_failure_ack.c index d01b99b..7e8e070 100644 --- a/src/mpid/ch3/src/mpid_comm_failure_ack.c +++ b/src/mpid/ch3/src/mpid_comm_failure_ack.c @@ -26,7 +26,7 @@ int MPID_Comm_failure_ack(MPID_Comm *comm_ptr) /* Update the marker for the last known failed process in this * communciator. */ - comm_ptr->ch.last_ack_rank = MPIDI_last_known_failed; + comm_ptr->dev.last_ack_rank = MPIDI_last_known_failed; fn_exit: MPIDI_FUNC_EXIT(MPID_STATE_MPID_COMM_FAILURE_ACK); @@ -49,7 +49,7 @@ int MPID_Comm_failure_get_acked(MPID_Comm *comm_ptr, MPID_Group **group_ptr) /* Get the group of all failed processes */ MPIDI_CH3U_Check_for_failed_procs(); - MPIDI_CH3U_Get_failed_group(comm_ptr->ch.last_ack_rank, &failed_group); + MPIDI_CH3U_Get_failed_group(comm_ptr->dev.last_ack_rank, &failed_group); if (failed_group == MPID_Group_empty) { *group_ptr = MPID_Group_empty; goto fn_exit; @@ -106,7 +106,7 @@ int MPID_Comm_failed_bitarray(MPID_Comm *comm_ptr, uint32_t **bitarray, int acke if (mpi_errno) MPIU_ERR_POP(mpi_errno); if (acked) - MPIDI_CH3U_Get_failed_group(comm_ptr->ch.last_ack_rank, &failed_group); + MPIDI_CH3U_Get_failed_group(comm_ptr->dev.last_ack_rank, &failed_group); else MPIDI_CH3U_Get_failed_group(-2, &failed_group); diff --git a/src/mpid/ch3/src/mpid_comm_revoke.c b/src/mpid/ch3/src/mpid_comm_revoke.c index 63993ae..8f9d457 100644 --- a/src/mpid/ch3/src/mpid_comm_revoke.c +++ b/src/mpid/ch3/src/mpid_comm_revoke.c @@ -70,11 +70,11 @@ int MPID_Comm_revoke(MPID_Comm *comm_ptr, int is_remote) /* Start a counter to track how many revoke messages we've received from * other ranks */ - comm_ptr->ch.waiting_for_revoke = comm_ptr->local_size - 1 - is_remote - failed; /* Subtract the processes who already know about the revoke */ - MPIU_DBG_MSG_FMT(CH3_OTHER, VERBOSE, (MPIU_DBG_FDEST, "Comm %08x waiting_for_revoke: %d", comm_ptr->handle, comm_ptr->ch.waiting_for_revoke)); + comm_ptr->dev.waiting_for_revoke = comm_ptr->local_size - 1 - is_remote - failed; /* Subtract the processes who already know about the revoke */ + MPIU_DBG_MSG_FMT(CH3_OTHER, VERBOSE, (MPIU_DBG_FDEST, "Comm %08x waiting_for_revoke: %d", comm_ptr->handle, comm_ptr->dev.waiting_for_revoke)); /* Check to see if we are done revoking */ - if (comm_ptr->ch.waiting_for_revoke == 0) { + if (comm_ptr->dev.waiting_for_revoke == 0) { MPIR_Comm_release(comm_ptr, 0); } @@ -89,11 +89,11 @@ int MPID_Comm_revoke(MPID_Comm *comm_ptr, int is_remote) MPIU_THREAD_CS_EXIT(MSGQUEUE,); } else if (is_remote) { /* If this is local, we've already revoked and don't need to do it again. */ /* Decrement the revoke counter */ - comm_ptr->ch.waiting_for_revoke--; - MPIU_DBG_MSG_FMT(CH3_OTHER, VERBOSE, (MPIU_DBG_FDEST, "Comm %08x waiting_for_revoke: %d", comm_ptr->handle, comm_ptr->ch.waiting_for_revoke)); + comm_ptr->dev.waiting_for_revoke--; + MPIU_DBG_MSG_FMT(CH3_OTHER, VERBOSE, (MPIU_DBG_FDEST, "Comm %08x waiting_for_revoke: %d", comm_ptr->handle, comm_ptr->dev.waiting_for_revoke)); /* Check to see if we are done revoking */ - if (comm_ptr->ch.waiting_for_revoke == 0) { + if (comm_ptr->dev.waiting_for_revoke == 0) { MPIR_Comm_release(comm_ptr, 0); } } diff --git a/src/mpid/ch3/src/mpid_init.c b/src/mpid/ch3/src/mpid_init.c index 16c425e..796d1f2 100644 --- a/src/mpid/ch3/src/mpid_init.c +++ b/src/mpid/ch3/src/mpid_init.c @@ -70,7 +70,7 @@ static int set_eager_threshold(MPID_Comm *comm_ptr, MPID_Info *info, void *state MPID_MPI_FUNC_ENTER(MPID_STATE_MPIDI_CH3_SET_EAGER_THRESHOLD); - comm_ptr->ch.eager_max_msg_sz = strtol(info->value, &endptr, 0); + comm_ptr->dev.eager_max_msg_sz = strtol(info->value, &endptr, 0); MPIU_ERR_CHKANDJUMP1(*endptr, mpi_errno, MPI_ERR_ARG, "**infohintparse", "**infohintparse %s", ----------------------------------------------------------------------- Summary of changes: .../ch3/channels/nemesis/include/mpidi_ch3_pre.h | 4 ++++ src/mpid/ch3/channels/nemesis/src/ch3i_comm.c | 14 +++++++------- src/mpid/ch3/channels/sock/include/mpidi_ch3_pre.h | 4 ++++ src/mpid/ch3/include/mpidimpl.h | 4 ++-- src/mpid/ch3/include/mpidpre.h | 6 +++--- src/mpid/ch3/src/ch3u_comm.c | 20 ++++++++++---------- src/mpid/ch3/src/mpid_comm_failure_ack.c | 6 +++--- src/mpid/ch3/src/mpid_comm_revoke.c | 12 ++++++------ src/mpid/ch3/src/mpid_init.c | 2 +- 9 files changed, 40 insertions(+), 32 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-114-gbbacb5b
by noreply＠mpich.org 26 Aug '14

26 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via bbacb5b5be1182924cd50416e7a05033e3a145dd (commit) from f7ad217b693fef4c93f43a9e7c3aecc29ae5598d (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/bbacb5b5be1182924cd50416e7a05033e… commit bbacb5b5be1182924cd50416e7a05033e3a145dd Author: Igor Ivanov <Igor.Ivanov(a)itseez.com> Date: Mon Aug 18 17:17:42 2014 +0300 netmod/mxm: Add global synchronization during init/fini Put a barrier inside initialization and finalization phases to make sure all ranks call mxm_ep_connect and mxm_ep_disconnect before and after mxm connections readiness. Signed-off-by: Igor Ivanov <Igor.Ivanov(a)itseez.com> Change-Id: I99d41517c58ce9767735a8eccc21ad360e824bf8 Signed-off-by: Pavan Balaji <balaji(a)anl.gov> diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h index 90ad8b8..3d5f5d4 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_impl.h @@ -211,6 +211,17 @@ static inline void list_grow_mxm_req(list_head_t * list_head) } } +static inline void _mxm_barrier(void) +{ + int pmi_errno; + +#ifdef USE_PMI2_API + pmi_errno = PMI2_KVS_Fence(); +#else + pmi_errno = PMI_Barrier(); +#endif +} + static inline void _mxm_to_mpi_status(mxm_error_t mxm_error, MPI_Status * mpi_status) { switch (mxm_error) { diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c index da5409a..eafe66a 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_init.c @@ -78,6 +78,8 @@ int MPID_nem_mxm_post_init(void) { int mpi_errno = MPI_SUCCESS; + _mxm_barrier(); + #if MXM_API >= MXM_VERSION(3,1) /* Current logic guarantees that all VCs have been initialized before post init call */ if (_mxm_obj.conf.bulk_connect) { @@ -151,6 +153,8 @@ int MPID_nem_mxm_finalize(void) MPIDI_STATE_DECL(MPID_STATE_MXM_FINALIZE); MPIDI_FUNC_ENTER(MPID_STATE_MXM_FINALIZE); + _mxm_barrier(); + mpi_errno = _mxm_fini(); if (mpi_errno) MPIU_ERR_POP(mpi_errno); ----------------------------------------------------------------------- Summary of changes: .../ch3/channels/nemesis/netmod/mxm/mxm_impl.h | 11 +++++++++++ .../ch3/channels/nemesis/netmod/mxm/mxm_init.c | 4 ++++ 2 files changed, 15 insertions(+), 0 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-113-gf7ad217
by noreply＠mpich.org 25 Aug '14

25 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via f7ad217b693fef4c93f43a9e7c3aecc29ae5598d (commit) via 7b13db5d8fa60d32e411ec93f821d6e449c54e1d (commit) via a184bd016a1f270b0a1d0242873587fc67780c5b (commit) via cf1240d657e9ff907670e3915fe5b9d36dbbd133 (commit) via 92ff146e205da604b1f1015e1b5a26997cf8333b (commit) via 07e6da06dbaa35a2f4f51df79d490bb749d2ca56 (commit) via 14fd9c432eac9b743ebabaf98b34da214541df12 (commit) from 0ddd8086a842302d296f4bdb719b36a33ba284d6 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/f7ad217b693fef4c93f43a9e7c3aecc29… commit f7ad217b693fef4c93f43a9e7c3aecc29ae5598d Author: Wesley Bland <wbland(a)anl.gov> Date: Thu Aug 21 11:08:41 2014 -0500 Expand search for comm_ptr When searching for a corresponding comm_ptr, we should also check the node_comm and node_roots_comm if they exist. Signed-off-by: Huiwei Lu <huiweilu(a)mcs.anl.gov> diff --git a/src/mpid/ch3/src/ch3u_comm.c b/src/mpid/ch3/src/ch3u_comm.c index e39cd89..871b1f2 100644 --- a/src/mpid/ch3/src/ch3u_comm.c +++ b/src/mpid/ch3/src/ch3u_comm.c @@ -340,8 +340,10 @@ void MPIDI_CH3I_Comm_find(MPIR_Context_id_t context_id, MPID_Comm **comm) MPIDI_FUNC_ENTER(MPIDI_STATE_MPIDI_CH3I_COMM_FIND); COMM_FOREACH((*comm)) { - if ((*comm)->context_id == context_id) { - MPIU_DBG_MSG_D(CH3_OTHER,VERBOSE,"Found matching context id: %d", context_id); + if ((*comm)->context_id == context_id || ((*comm)->context_id + MPID_CONTEXT_INTRA_COLL) == context_id || + ((*comm)->node_comm && ((*comm)->node_comm->context_id == context_id || ((*comm)->node_comm->context_id + MPID_CONTEXT_INTRA_COLL) == context_id)) || + ((*comm)->node_roots_comm && ((*comm)->node_roots_comm->context_id == context_id || ((*comm)->node_roots_comm->context_id + MPID_CONTEXT_INTRA_COLL) == context_id)) ) { + MPIU_DBG_MSG_D(CH3_OTHER,VERBOSE,"Found matching context id: %d", (*comm)->context_id); break; } } http://git.mpich.org/mpich.git/commitdiff/7b13db5d8fa60d32e411ec93f821d6e44… commit 7b13db5d8fa60d32e411ec93f821d6e449c54e1d Author: Wesley Bland <wbland(a)anl.gov> Date: Thu Aug 21 11:01:18 2014 -0500 Revoke any node aware "subcommunicators" as well When revoking a communicator, if it has node aware communicators attached to it (as node_comm and node_roots_comm), revoke those as well. Signed-off-by: Huiwei Lu <huiweilu(a)mcs.anl.gov> diff --git a/src/mpid/ch3/src/mpid_comm_revoke.c b/src/mpid/ch3/src/mpid_comm_revoke.c index 7a10b7d..63993ae 100644 --- a/src/mpid/ch3/src/mpid_comm_revoke.c +++ b/src/mpid/ch3/src/mpid_comm_revoke.c @@ -35,6 +35,8 @@ int MPID_Comm_revoke(MPID_Comm *comm_ptr, int is_remote) if (0 == comm_ptr->revoked) { /* Mark the communicator as revoked locally */ comm_ptr->revoked = 1; + if (comm_ptr->node_comm) comm_ptr->node_comm->revoked = 1; + if (comm_ptr->node_roots_comm) comm_ptr->node_roots_comm->revoked = 1; /* Keep a reference to this comm so it doesn't get destroyed while * it's being revoked */ http://git.mpich.org/mpich.git/commitdiff/a184bd016a1f270b0a1d0242873587fc6… commit a184bd016a1f270b0a1d0242873587fc67780c5b Author: Wesley Bland <wbland(a)anl.gov> Date: Thu Aug 21 10:19:20 2014 -0500 Don't put revoked requests into the receive queue When a message is received, if the communicator has already been revoked, we shouldn't bother keeping the message since it's now invalid (unless its for an AGREE or SHRINK request). Instead, just drop the request and return a null request to signal the calling function that the request was ignored. Signed-off-by: Huiwei Lu <huiweilu(a)mcs.anl.gov> diff --git a/src/mpid/ch3/channels/nemesis/src/mpid_nem_lmt.c b/src/mpid/ch3/channels/nemesis/src/mpid_nem_lmt.c index de31188..5c10104 100644 --- a/src/mpid/ch3/channels/nemesis/src/mpid_nem_lmt.c +++ b/src/mpid/ch3/channels/nemesis/src/mpid_nem_lmt.c @@ -176,6 +176,14 @@ static int pkt_RTS_handler(MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt, MPIDI_msg_sz_t rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&rts_pkt->match, &found); MPIU_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp()); + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + *rreqp = NULL; + goto fn_exit; + } + set_request_info(rreq, rts_pkt, MPIDI_REQUEST_RNDV_MSG); rreq->ch.lmt_req_id = rts_pkt->sender_req_id; diff --git a/src/mpid/ch3/src/ch3u_eager.c b/src/mpid/ch3/src/ch3u_eager.c index bbcd179..92440a0 100644 --- a/src/mpid/ch3/src/ch3u_eager.c +++ b/src/mpid/ch3/src/ch3u_eager.c @@ -305,6 +305,14 @@ int MPIDI_CH3_PktHandler_EagerShortSend( MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt, rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&eagershort_pkt->match, &found); MPIU_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp()); + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + *rreqp = NULL; + goto fn_fail; + } + (rreq)->status.MPI_SOURCE = (eagershort_pkt)->match.parts.rank; (rreq)->status.MPI_TAG = (eagershort_pkt)->match.parts.tag; MPIR_STATUS_SET_COUNT((rreq)->status, (eagershort_pkt)->data_sz); @@ -610,6 +618,14 @@ int MPIDI_CH3_PktHandler_EagerSend( MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt, rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&eager_pkt->match, &found); MPIU_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp()); + + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + *rreqp = NULL; + goto fn_fail; + } set_request_info(rreq, eager_pkt, MPIDI_REQUEST_EAGER_MSG); @@ -686,6 +702,14 @@ int MPIDI_CH3_PktHandler_ReadySend( MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt, rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&ready_pkt->match, &found); MPIU_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp()); + + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + *rreqp = NULL; + goto fn_fail; + } set_request_info(rreq, ready_pkt, MPIDI_REQUEST_EAGER_MSG); diff --git a/src/mpid/ch3/src/ch3u_eagersync.c b/src/mpid/ch3/src/ch3u_eagersync.c index f88501c..48cd5eb 100644 --- a/src/mpid/ch3/src/ch3u_eagersync.c +++ b/src/mpid/ch3/src/ch3u_eagersync.c @@ -235,6 +235,14 @@ int MPIDI_CH3_PktHandler_EagerSyncSend( MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt, rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&es_pkt->match, &found); MPIU_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp()); + + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + *rreqp = NULL; + goto fn_fail; + } set_request_info(rreq, es_pkt, MPIDI_REQUEST_EAGER_MSG); diff --git a/src/mpid/ch3/src/ch3u_recvq.c b/src/mpid/ch3/src/ch3u_recvq.c index 1e1dbb8..f1f2443 100644 --- a/src/mpid/ch3/src/ch3u_recvq.c +++ b/src/mpid/ch3/src/ch3u_recvq.c @@ -808,6 +808,26 @@ MPID_Request * MPIDI_CH3U_Recvq_FDP_or_AEU(MPIDI_Message_match * match, } MPIR_T_PVAR_TIMER_END(RECVQ, time_failed_matching_postedq); + /* If we didn't match the request, look to see if the communicator is + * revoked. If so, just throw this request away since it won't be used + * anyway. */ + { + MPID_Comm *comm_ptr; + int mpi_errno; + + MPIDI_CH3I_Comm_find(match->parts.context_id, &comm_ptr); + + if (comm_ptr && comm_ptr->revoked && MPIR_TAG_MASK_ERROR_BIT(match->parts.tag) != MPIR_AGREE_TAG && + comm_ptr->revoked && MPIR_TAG_MASK_ERROR_BIT(match->parts.tag) != MPIR_SHRINK_TAG) { + *foundp = FALSE; + MPIDI_Request_create_null_rreq( rreq, mpi_errno, found=FALSE;goto lock_exit ); + + MPIU_DBG_MSG_FMT(CH3_OTHER, VERBOSE, + (MPIU_DBG_FDEST, "RECEIVED MESSAGE FOR REVOKED COMM (tag=%d,src=%d,cid=%d)\n", MPIR_TAG_MASK_ERROR_BIT(match->parts.tag), match->parts.rank, comm_ptr->context_id)); + return rreq; + } + } + /* A matching request was not found in the posted queue, so we need to allocate a new request and add it to the unexpected queue */ { diff --git a/src/mpid/ch3/src/ch3u_rndv.c b/src/mpid/ch3/src/ch3u_rndv.c index 4ab7478..6861f44 100644 --- a/src/mpid/ch3/src/ch3u_rndv.c +++ b/src/mpid/ch3/src/ch3u_rndv.c @@ -127,6 +127,14 @@ int MPIDI_CH3_PktHandler_RndvReqToSend( MPIDI_VC_t *vc, MPIDI_CH3_Pkt_t *pkt, MPIU_THREAD_CS_ENTER(MSGQUEUE,); rreq = MPIDI_CH3U_Recvq_FDP_or_AEU(&rts_pkt->match, &found); MPIU_ERR_CHKANDJUMP1(!rreq, mpi_errno,MPI_ERR_OTHER, "**nomemreq", "**nomemuereq %d", MPIDI_CH3U_Recvq_count_unexp()); + + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + *rreqp = NULL; + goto fn_fail; + } set_request_info(rreq, rts_pkt, MPIDI_REQUEST_RNDV_MSG); diff --git a/src/mpid/ch3/src/mpidi_isend_self.c b/src/mpid/ch3/src/mpidi_isend_self.c index 2961a07..b003e6e 100644 --- a/src/mpid/ch3/src/mpidi_isend_self.c +++ b/src/mpid/ch3/src/mpidi_isend_self.c @@ -56,6 +56,16 @@ int MPIDI_Isend_self(const void * buf, int count, MPI_Datatype datatype, int ran } /* --END ERROR HANDLING-- */ + /* If the completion counter is 0, that means that the communicator to + * which this message is being sent has been revoked and we shouldn't + * bother finishing this. */ + if (!found && rreq->cc == 0) { + MPIU_Object_set_ref(sreq, 0); + MPIDI_CH3_Request_destroy(sreq); + sreq = NULL; + goto fn_exit; + } + MPIDI_Comm_get_vc_set_active(comm, rank, &vc); MPIDI_VC_FAI_send_seqnum(vc, seqnum); MPIDI_Request_set_seqnum(sreq, seqnum); http://git.mpich.org/mpich.git/commitdiff/cf1240d657e9ff907670e3915fe5b9d36… commit cf1240d657e9ff907670e3915fe5b9d36dbbd133 Author: Wesley Bland <wbland(a)anl.gov> Date: Mon Aug 18 14:06:47 2014 -0500 Fix error case for MPIDI_Request_create_null_rreq For some reason, the error case code between MPIDI_Request_create_rreq and MPIDI_Request_create_null_rreq was different. This is odd, because both macros take FAIL_ as an argument which is executed directly in the error case of create_rreq, but not in null_req. This commit makes the two act the same and updates the only two calls to the function that existed in the code. Signed-off-by: Huiwei Lu <huiweilu(a)mcs.anl.gov> diff --git a/src/mpid/ch3/include/mpidimpl.h b/src/mpid/ch3/include/mpidimpl.h index 5e3f82f..b6ee2ef 100644 --- a/src/mpid/ch3/include/mpidimpl.h +++ b/src/mpid/ch3/include/mpidimpl.h @@ -400,7 +400,9 @@ extern MPIDI_Process_t MPIDI_Process; MPIR_Status_set_procnull(&(rreq_)->status); \ } \ else { \ - MPIU_ERR_SETANDJUMP(mpi_errno_,MPI_ERR_OTHER,"**nomemreq"); \ + MPIU_DBG_MSG(CH3_CHANNEL,TYPICAL,"unable to allocate a request");\ + (mpi_errno_) = MPIR_ERR_MEMALLOCFAILED; \ + FAIL_; \ } \ } while (0) diff --git a/src/mpid/ch3/src/mpid_imrecv.c b/src/mpid/ch3/src/mpid_imrecv.c index 0acb680..7097fe1 100644 --- a/src/mpid/ch3/src/mpid_imrecv.c +++ b/src/mpid/ch3/src/mpid_imrecv.c @@ -22,7 +22,7 @@ int MPID_Imrecv(void *buf, int count, MPI_Datatype datatype, * upper level */ if (message == NULL) { - MPIDI_Request_create_null_rreq(rreq, mpi_errno, fn_fail); + MPIDI_Request_create_null_rreq(rreq, mpi_errno, goto fn_fail); *rreqp = rreq; goto fn_exit; } diff --git a/src/mpid/ch3/src/mpid_irecv.c b/src/mpid/ch3/src/mpid_irecv.c index 1c75d20..7a30ad4 100644 --- a/src/mpid/ch3/src/mpid_irecv.c +++ b/src/mpid/ch3/src/mpid_irecv.c @@ -27,7 +27,7 @@ int MPID_Irecv(void * buf, int count, MPI_Datatype datatype, int rank, int tag, if (rank == MPI_PROC_NULL) { - MPIDI_Request_create_null_rreq(rreq, mpi_errno, fn_fail); + MPIDI_Request_create_null_rreq(rreq, mpi_errno, goto fn_fail); goto fn_exit; } http://git.mpich.org/mpich.git/commitdiff/92ff146e205da604b1f1015e1b5a26997… commit 92ff146e205da604b1f1015e1b5a26997cf8333b Author: Wesley Bland <wbland(a)anl.gov> Date: Thu Aug 21 10:02:53 2014 -0500 Fix some problems with get_all_failed at larger scales After some more testing on fusion, some problems transmitting the failed procs bitarray sprang up. This seems to solve those problems now. Signed-off-by: Huiwei Lu <huiweilu(a)mcs.anl.gov> diff --git a/src/mpid/ch3/src/mpid_comm_get_all_failed_procs.c b/src/mpid/ch3/src/mpid_comm_get_all_failed_procs.c index c8eb7f6..9d29cf6 100644 --- a/src/mpid/ch3/src/mpid_comm_get_all_failed_procs.c +++ b/src/mpid/ch3/src/mpid_comm_get_all_failed_procs.c @@ -14,7 +14,7 @@ /* Generates a bitarray based on orig_comm where all procs in group are marked with 1 */ static int *group_to_bitarray(MPID_Group *group, MPID_Comm *orig_comm) { uint32_t *bitarray, mask; - int bitarray_size = orig_comm->local_size / 8 + orig_comm->local_size % 8 ? 1 : 0; + int bitarray_size = (orig_comm->local_size / 8) + (orig_comm->local_size % 8 ? 1 : 0); int *group_ranks, *comm_ranks, i, index; bitarray = (int *) MPIU_Malloc(sizeof(int) * bitarray_size); @@ -46,7 +46,7 @@ static int *group_to_bitarray(MPID_Group *group, MPID_Comm *orig_comm) { } /* Generates an MPID_Group from a bitarray */ -static MPID_Group *bitarray_to_group(MPID_Comm *comm_ptr, int *bitarray) +static MPID_Group *bitarray_to_group(MPID_Comm *comm_ptr, uint32_t *bitarray) { MPID_Group *ret_group; MPID_Group *comm_group; @@ -59,7 +59,7 @@ static MPID_Group *bitarray_to_group(MPID_Comm *comm_ptr, int *bitarray) /* Converts the bitarray into a utarray */ for (i = 0; i < comm_ptr->local_size; i++) { - if (bitarray[i/32] & (0x80000000 >> i % 32)) { + if (bitarray[i/32] & (0x80000000 >> (i % 32))) { utarray_push_back(ranks_array, &i); found++; } @@ -85,8 +85,8 @@ int MPID_Comm_get_all_failed_procs(MPID_Comm *comm_ptr, MPID_Group **failed_grou { int mpi_errno = MPI_SUCCESS; int errflag = 0; - int i, j; - int *bitarray, *remote_bitarray, bitarray_size; + int i, j, bitarray_size; + uint32_t *bitarray, *remote_bitarray; MPID_Group *local_fail; MPIDI_STATE_DECL(MPID_STATE_MPID_COMM_GET_ALL_FAILED_PROCS); @@ -104,26 +104,29 @@ int MPID_Comm_get_all_failed_procs(MPID_Comm *comm_ptr, MPID_Group **failed_grou /* Generate a bitarray based on the list of failed procs */ bitarray = group_to_bitarray(local_fail, comm_ptr); - bitarray_size = comm_ptr->local_size / 8 + comm_ptr->local_size % 8 ? 1 : 0; - remote_bitarray = MPIU_Malloc(sizeof(int) * bitarray_size); + bitarray_size = (comm_ptr->local_size / 8) + (comm_ptr->local_size % 8 ? 1 : 0); + remote_bitarray = MPIU_Malloc(sizeof(uint32_t) * bitarray_size); /* For now, this will be implemented as a star with rank 0 serving as * the source */ if (comm_ptr->rank == 0) { for (i = 1; i < comm_ptr->local_size; i++) { /* Get everyone's list of failed processes to aggregate */ - mpi_errno = MPIC_Recv(remote_bitarray, bitarray_size, MPI_INT, + mpi_errno = MPIC_Recv(remote_bitarray, bitarray_size, MPI_UINT32_T, i, tag, comm_ptr->handle, MPI_STATUS_IGNORE, &errflag); if (mpi_errno) continue; /* Combine the received bitarray with my own */ - for (j = 0; j < bitarray_size; j++) - bitarray[j] |= remote_bitarray[j]; + for (j = 0; j < bitarray_size; j++) { + if (remote_bitarray[j] != 0) { + bitarray[j] |= remote_bitarray[j]; + } + } } for (i = 1; i < comm_ptr->local_size; i++) { /* Send the list to each rank to be processed locally */ - mpi_errno = MPIC_Ssend(bitarray, bitarray_size, MPI_INT, i, + mpi_errno = MPIC_Send(bitarray, bitarray_size, MPI_UINT32_T, i, tag, comm_ptr->handle, &errflag); if (mpi_errno) errflag = 1; } @@ -132,12 +135,12 @@ int MPID_Comm_get_all_failed_procs(MPID_Comm *comm_ptr, MPID_Group **failed_grou *failed_group = bitarray_to_group(comm_ptr, bitarray); } else { /* Send my bitarray to rank 0 */ - mpi_errno = MPIC_Ssend(bitarray, bitarray_size, MPI_INT, 0, + mpi_errno = MPIC_Send(bitarray, bitarray_size, MPI_UINT32_T, 0, tag, comm_ptr->handle, &errflag); if (mpi_errno) errflag = 1; /* Get the resulting bitarray back from rank 0 */ - mpi_errno = MPIC_Recv(remote_bitarray, bitarray_size, MPI_INT, 0, + mpi_errno = MPIC_Recv(remote_bitarray, bitarray_size, MPI_UINT32_T, 0, tag, comm_ptr->handle, MPI_STATUS_IGNORE, &errflag); if (mpi_errno) errflag = 1; http://git.mpich.org/mpich.git/commitdiff/07e6da06dbaa35a2f4f51df79d490bb74… commit 07e6da06dbaa35a2f4f51df79d490bb749d2ca56 Author: Huiwei Lu <huiweilu(a)mcs.anl.gov> Date: Fri Aug 8 15:53:24 2014 -0500 Adds a canceling case for barrier_smp_intra barrier_smp_intra completes the barrier in two steps, first for intra smp nodes, then for inter smp nodes. It uses an additional node_comm for intra smp barrier. This node_comm should also be cancelled inside MPIDI_CH3U_Clean_recvq when communicator is revoked. Signed-off-by: Wesley Bland <wbland(a)anl.gov> diff --git a/src/mpi/comm/commutil.c b/src/mpi/comm/commutil.c index cae702f..8713a2f 100644 --- a/src/mpi/comm/commutil.c +++ b/src/mpi/comm/commutil.c @@ -500,6 +500,7 @@ int MPIR_Comm_commit(MPID_Comm *comm) comm->node_comm->comm_kind = MPID_INTRACOMM; comm->node_comm->hierarchy_kind = MPID_HIERARCHY_NODE; comm->node_comm->local_comm = NULL; + MPIU_DBG_MSG_D(CH3_OTHER,VERBOSE,"Create node_comm=%p\n", comm->node_comm); comm->node_comm->local_size = num_local; comm->node_comm->remote_size = num_local; diff --git a/src/mpid/ch3/src/ch3u_recvq.c b/src/mpid/ch3/src/ch3u_recvq.c index eddfe94..1e1dbb8 100644 --- a/src/mpid/ch3/src/ch3u_recvq.c +++ b/src/mpid/ch3/src/ch3u_recvq.c @@ -945,6 +945,21 @@ int MPIDI_CH3U_Clean_recvq(MPID_Comm *comm_ptr) } } + if (MPIR_CVAR_ENABLE_SMP_COLLECTIVES && MPIR_Comm_is_node_aware(comm_ptr)) { + int offset = (comm_ptr->comm_kind == MPID_INTRACOMM) ? MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL; + match.parts.context_id = comm_ptr->recvcontext_id + MPID_CONTEXT_INTRANODE_OFFSET + offset; + + if (MATCH_WITH_LEFT_RIGHT_MASK(rreq->dev.match, match, mask)) { + if (rreq->dev.match.parts.tag != MPIR_AGREE_TAG && rreq->dev.match.parts.tag != MPIR_SHRINK_TAG) { + MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST, + "cleaning up unexpected collective pkt rank=%d tag=%d contextid=%d", + rreq->dev.match.parts.rank, rreq->dev.match.parts.tag, rreq->dev.match.parts.context_id)); + dequeue_and_set_error(&rreq, prev_rreq, &recvq_unexpected_head, &recvq_unexpected_tail, &error, MPI_PROC_NULL); + continue; + } + } + } + prev_rreq = rreq; rreq = rreq->dev.next; } @@ -959,7 +974,7 @@ int MPIDI_CH3U_Clean_recvq(MPID_Comm *comm_ptr) if (MATCH_WITH_LEFT_RIGHT_MASK(rreq->dev.match, match, mask)) { MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST, - "cleaning up unexpected pt2pt pkt rank=%d tag=%d contextid=%d", + "cleaning up posted pt2pt pkt rank=%d tag=%d contextid=%d", rreq->dev.match.parts.rank, rreq->dev.match.parts.tag, rreq->dev.match.parts.context_id)); dequeue_and_set_error(&rreq, prev_rreq, &recvq_posted_head, &recvq_posted_tail, &error, MPI_PROC_NULL); continue; @@ -970,13 +985,28 @@ int MPIDI_CH3U_Clean_recvq(MPID_Comm *comm_ptr) if (MATCH_WITH_LEFT_RIGHT_MASK(rreq->dev.match, match, mask)) { if (rreq->dev.match.parts.tag != MPIR_AGREE_TAG && rreq->dev.match.parts.tag != MPIR_SHRINK_TAG) { MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST, - "cleaning up unexpected collective pkt rank=%d tag=%d contextid=%d", + "cleaning up posted collective pkt rank=%d tag=%d contextid=%d", rreq->dev.match.parts.rank, rreq->dev.match.parts.tag, rreq->dev.match.parts.context_id)); dequeue_and_set_error(&rreq, prev_rreq, &recvq_posted_head, &recvq_posted_tail, &error, MPI_PROC_NULL); continue; } } + if (MPIR_CVAR_ENABLE_SMP_COLLECTIVES && MPIR_Comm_is_node_aware(comm_ptr)) { + int offset = (comm_ptr->comm_kind == MPID_INTRACOMM) ? MPID_CONTEXT_INTRA_COLL : MPID_CONTEXT_INTER_COLL; + match.parts.context_id = comm_ptr->recvcontext_id + MPID_CONTEXT_INTRANODE_OFFSET + offset; + + if (MATCH_WITH_LEFT_RIGHT_MASK(rreq->dev.match, match, mask)) { + if (rreq->dev.match.parts.tag != MPIR_AGREE_TAG && rreq->dev.match.parts.tag != MPIR_SHRINK_TAG) { + MPIU_DBG_MSG_FMT(CH3_OTHER,VERBOSE,(MPIU_DBG_FDEST, + "cleaning up posted collective pkt rank=%d tag=%d contextid=%d", + rreq->dev.match.parts.rank, rreq->dev.match.parts.tag, rreq->dev.match.parts.context_id)); + dequeue_and_set_error(&rreq, prev_rreq, &recvq_posted_head, &recvq_posted_tail, &error, MPI_PROC_NULL); + continue; + } + } + } + prev_rreq = rreq; rreq = rreq->dev.next; } http://git.mpich.org/mpich.git/commitdiff/14fd9c432eac9b743ebabaf98b34da214… commit 14fd9c432eac9b743ebabaf98b34da214541df12 Author: Wesley Bland <wbland(a)anl.gov> Date: Fri Aug 1 12:49:22 2014 -0500 Correctly report the error class in receive queue The receive queue had some hacky ways of reporting errors related to process failure that didn't really match up with the way the codes should be returned correctly. This patch sets the correct error class in the correct place and doesn't require extra logic in dequeue_and_set_error to set the class itself. This seems to get a couple of the tests to pass in non-debug mode. Signed-off-by: Huiwei Lu <huiweilu(a)mcs.anl.gov> diff --git a/src/mpid/ch3/src/ch3u_recvq.c b/src/mpid/ch3/src/ch3u_recvq.c index ea8bf34..eddfe94 100644 --- a/src/mpid/ch3/src/ch3u_recvq.c +++ b/src/mpid/ch3/src/ch3u_recvq.c @@ -863,13 +863,6 @@ static inline int req_uses_vc(const MPID_Request* req, const MPIDI_VC_t *vc) static inline void dequeue_and_set_error(MPID_Request **req, MPID_Request *prev_req, MPID_Request **head, MPID_Request **tail, int *error, int rank) { MPID_Request *next = (*req)->dev.next; - - if (*error == MPI_SUCCESS) { - if (rank == MPI_PROC_NULL) - MPIU_ERR_SET(*error, MPIX_ERR_PROC_FAILED, "**comm_fail"); - else - MPIU_ERR_SET1(*error, MPIX_ERR_PROC_FAILED, "**comm_fail", "**comm_fail %d", rank); - } /* remove from queue */ if (*head == *req) { @@ -907,7 +900,7 @@ static inline void dequeue_and_set_error(MPID_Request **req, MPID_Request *prev int MPIDI_CH3U_Clean_recvq(MPID_Comm *comm_ptr) { int mpi_errno = MPI_SUCCESS; - int error = MPIX_ERR_REVOKED; + int error = MPI_SUCCESS; MPID_Request *rreq, *prev_rreq = NULL; MPIDI_Message_match match; MPIDI_Message_match mask; @@ -917,6 +910,8 @@ int MPIDI_CH3U_Clean_recvq(MPID_Comm *comm_ptr) MPIU_THREAD_CS_ASSERT_HELD(MSGQUEUE); + MPIU_ERR_SETSIMPLE(error, MPIX_ERR_REVOKED, "**revoked"); + rreq = recvq_unexpected_head; mask.parts.context_id = ~0; mask.parts.rank = mask.parts.tag = 0; @@ -1004,7 +999,9 @@ int MPIDI_CH3U_Complete_disabled_anysources(void) MPIDI_FUNC_ENTER(MPID_STATE_MPIDI_CH3U_COMPLETE_DISABLED_ANYSOURCES); MPIU_THREAD_CS_ENTER(MSGQUEUE,); - + + MPIU_ERR_SETSIMPLE(error, MPIX_ERR_PROC_FAILED_PENDING, "**failure_pending"); + /* Check each request in the posted queue, and complete-with-error any anysource requests posted on communicators that have disabled anysources */ @@ -1044,6 +1041,8 @@ int MPIDI_CH3U_Complete_posted_with_error(MPIDI_VC_t *vc) MPIU_THREAD_CS_ENTER(MSGQUEUE,); + MPIU_ERR_SETSIMPLE(error, MPIX_ERR_PROC_FAILED, "**proc_failed"); + /* check each req in the posted queue and complete-with-error any requests using this VC. */ req = recvq_posted_head; diff --git a/test/mpi/ft/testlist b/test/mpi/ft/testlist index b60859e..3a89979 100644 --- a/test/mpi/ft/testlist +++ b/test/mpi/ft/testlist @@ -13,6 +13,6 @@ reduce 4 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=f bcast 4 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 xfail=ticket1945 scatter 4 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 xfail=ticket1945 anysource 3 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 xfail=ticket1945 -revoke_nofail 4 mpiexecarg=-disable-auto-cleanup resultsTest=TestStatusNoErrors strict=false timelimit=10 xfail=ticket1945 -shrink 8 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 xfail=ticket1945 +revoke_nofail 4 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 xfail=ticket1945 +shrink 8 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 agree 4 mpiexecarg=-disable-auto-cleanup resultTest=TestStatusNoErrors strict=false timeLimit=10 xfail=ticket1945 ----------------------------------------------------------------------- Summary of changes: src/mpi/comm/commutil.c | 1 + src/mpid/ch3/channels/nemesis/src/mpid_nem_lmt.c | 8 +++ src/mpid/ch3/include/mpidimpl.h | 4 +- src/mpid/ch3/src/ch3u_comm.c | 6 +- src/mpid/ch3/src/ch3u_eager.c | 24 +++++++ src/mpid/ch3/src/ch3u_eagersync.c | 8 +++ src/mpid/ch3/src/ch3u_recvq.c | 71 +++++++++++++++++--- src/mpid/ch3/src/ch3u_rndv.c | 8 +++ src/mpid/ch3/src/mpid_comm_get_all_failed_procs.c | 29 +++++---- src/mpid/ch3/src/mpid_comm_revoke.c | 2 + src/mpid/ch3/src/mpid_imrecv.c | 2 +- src/mpid/ch3/src/mpid_irecv.c | 2 +- src/mpid/ch3/src/mpidi_isend_self.c | 10 +++ test/mpi/ft/testlist | 4 +- 14 files changed, 148 insertions(+), 31 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-106-g0ddd808
by noreply＠mpich.org 22 Aug '14

22 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via 0ddd8086a842302d296f4bdb719b36a33ba284d6 (commit) via a4868b873705cd5f13ed14e773f5a6e53c0b5b08 (commit) via bb7661e18a2842c879ad5bbd45509e1ae6264eb0 (commit) from 6dff3b96066195508406bea51ee551060a4f6fad (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/0ddd8086a842302d296f4bdb719b36a33… commit 0ddd8086a842302d296f4bdb719b36a33ba284d6 Author: Rob Latham <robl(a)mcs.anl.gov> Date: Wed Aug 13 15:12:42 2014 -0500 scalable system-hints processing instead of every process reading and processing the hint config file, one process will read and broadcast, then everyone will process. Yay! fewer file system calls! Signed-off-by: Paul Coffman <pkcoff(a)us.ibm.com> diff --git a/src/mpi/romio/adio/common/ad_init.c b/src/mpi/romio/adio/common/ad_init.c index cec6219..88e75a5 100644 --- a/src/mpi/romio/adio/common/ad_init.c +++ b/src/mpi/romio/adio/common/ad_init.c @@ -78,11 +78,6 @@ void ADIO_Init(int *argc, char ***argv, int *error_code) else ADIOI_Direct_write = 0; #endif - /* Assume system-wide hints won't change between runs: move hint processing - * from ADIO_Open to here */ - /* FIXME should be checking error code from MPI_Info_create here */ - MPI_Info_create(&ADIOI_syshints); - ADIOI_process_system_hints(ADIOI_syshints); #ifdef ADIOI_MPE_LOGGING { diff --git a/src/mpi/romio/adio/common/ad_open.c b/src/mpi/romio/adio/common/ad_open.c index e6b96c4..67eb125 100644 --- a/src/mpi/romio/adio/common/ad_open.c +++ b/src/mpi/romio/adio/common/ad_open.c @@ -88,6 +88,24 @@ MPI_File ADIO_Open(MPI_Comm orig_comm, fd->hints->initialized = 0; fd->info = MPI_INFO_NULL; + /* move system-wide hint processing *back* into open, but this time the + * hintfile reader will do a scalable read-and-broadcast. The global + * ADIOI_syshints will get initialized at first open. subsequent open + * calls will just use result from first open. + * + * We have two goals here: + * 1: avoid processing the hintfile multiple times + * 2: have all processes participate in hintfile processing (so we can read-and-broadcast) + * + * a code might do an "initialize from 0", so we can only skip hint + * processing once everyone has particpiated in hint processing */ + int dummy_info; + MPI_Allreduce(&ADIOI_syshints, &dummy_info, 1, MPI_INT, MPI_MIN, fd->comm); + if ((MPI_Info)dummy_info== MPI_INFO_NULL) { + MPI_Info_create(&ADIOI_syshints); + ADIOI_process_system_hints(fd, ADIOI_syshints); + } + ADIOI_incorporate_system_hints(info, ADIOI_syshints, &dupinfo); ADIO_SetInfo(fd, dupinfo, &err); if (dupinfo != MPI_INFO_NULL) { diff --git a/src/mpi/romio/adio/common/system_hints.c b/src/mpi/romio/adio/common/system_hints.c index a527a26..0a2c642 100644 --- a/src/mpi/romio/adio/common/system_hints.c +++ b/src/mpi/romio/adio/common/system_hints.c @@ -85,8 +85,11 @@ static int find_file(void) * alone on the assumption that the caller knows best. * * because MPI-IO hints are optional, we can get away with limited error - * reporting. */ -static int file_to_info(int fd, MPI_Info info) + * reporting. + * + * for better scalability, the config file will be read on one processor and + * broadcast to all others */ +static int file_to_info_all(int fd, MPI_Info info, int rank, MPI_Comm comm) { char *buffer, *token, *key, *val, *garbage; char *pos1=NULL, *pos2=NULL; @@ -97,11 +100,19 @@ static int file_to_info(int fd, MPI_Info info) /* assumption: config files will be small */ #define HINTFILE_MAX_SIZE 1024*4 buffer = (char *)ADIOI_Calloc(HINTFILE_MAX_SIZE, sizeof (char)); - if (buffer == NULL) return -1; - ret = read(fd, buffer, HINTFILE_MAX_SIZE); - if (ret < 0) return -1; + if (rank == 0) { + ret = read(fd, buffer, HINTFILE_MAX_SIZE); + /* any error: bad/nonexistent fd, no perms, anything: set up a null + * buffer and the subsequent string parsing will quit immediately */ + if (ret == -1) + buffer[0] = '\0'; + } + MPI_Bcast(buffer, HINTFILE_MAX_SIZE, MPI_BYTE, 0, comm); + token = strtok_r(buffer, "\n", &pos1); + if (token == NULL) + goto fn_exit; do { if ( (key = strtok_r(token, " \t", &pos2)) == NULL) /* malformed line: found no items */ @@ -125,23 +136,25 @@ static int file_to_info(int fd, MPI_Info info) if (flag == 1) continue; ADIOI_Info_set(info, key, val); } while ((token = strtok_r(NULL, "\n", &pos1)) != NULL); + +fn_exit: ADIOI_Free(buffer); return 0; } -void ADIOI_process_system_hints(MPI_Info info) +void ADIOI_process_system_hints(ADIO_File fd, MPI_Info info) { - int hintfd; + int hintfd=-1, rank; - hintfd = find_file(); - if (hintfd < 0) { -#ifdef SYSHINT_DEBUG - perror("ADIOI_process_system_hints"); -#endif - return; + MPI_Comm_rank(fd->comm, &rank); + if (rank == 0) { + hintfd = find_file(); } - file_to_info(hintfd, info); - close(hintfd); + /* hintfd only significant on rank 0. -1 (on rank 0) means no hintfile found */ + file_to_info_all(hintfd, info, rank, fd->comm); + + if (hintfd != -1) + close(hintfd); } /* given 'info', incorporate any hints in 'sysinfo' that are not already set diff --git a/src/mpi/romio/adio/include/adioi.h b/src/mpi/romio/adio/include/adioi.h index 65e2bcd..e3f9a16 100644 --- a/src/mpi/romio/adio/include/adioi.h +++ b/src/mpi/romio/adio/include/adioi.h @@ -340,7 +340,7 @@ void ADIOI_Get_position(ADIO_File fd, ADIO_Offset *offset); void ADIOI_Get_eof_offset(ADIO_File fd, ADIO_Offset *eof_offset); void ADIOI_Get_byte_offset(ADIO_File fd, ADIO_Offset offset, ADIO_Offset *disp); -void ADIOI_process_system_hints(MPI_Info info); +void ADIOI_process_system_hints(ADIO_File fd, MPI_Info info); void ADIOI_incorporate_system_hints(MPI_Info info, MPI_Info sysinfo, MPI_Info *new_info); void ADIOI_Info_print_keyvals(MPI_Info info); http://git.mpich.org/mpich.git/commitdiff/a4868b873705cd5f13ed14e773f5a6e53… commit a4868b873705cd5f13ed14e773f5a6e53c0b5b08 Author: Rob Latham <robl(a)mcs.anl.gov> Date: Wed Aug 13 10:28:13 2014 -0500 systemwide-hints: no need for stat We'll just over-allocate enough space for a bunch of hints, instead of trying to get it exactly right. Signed-off-by: Paul Coffman <pkcoff(a)us.ibm.com> diff --git a/src/mpi/romio/adio/common/system_hints.c b/src/mpi/romio/adio/common/system_hints.c index 665c79e..a527a26 100644 --- a/src/mpi/romio/adio/common/system_hints.c +++ b/src/mpi/romio/adio/common/system_hints.c @@ -21,9 +21,6 @@ #ifdef HAVE_STRING_H #include <string.h> #endif -#ifdef HAVE_SYS_STAT_H -#include <sys/stat.h> -#endif #ifdef HAVE_UNISTD_H #include <unistd.h> #endif @@ -96,15 +93,13 @@ static int file_to_info(int fd, MPI_Info info) int flag; ssize_t ret; char dummy; - struct stat statbuf; - /* assumption: config files will be small (less than 1MB) */ - fstat(fd, &statbuf); - /* add 1 to size to make room for NULL termination */ - buffer = (char *)ADIOI_Calloc(statbuf.st_size + 1, sizeof (char)); + /* assumption: config files will be small */ +#define HINTFILE_MAX_SIZE 1024*4 + buffer = (char *)ADIOI_Calloc(HINTFILE_MAX_SIZE, sizeof (char)); if (buffer == NULL) return -1; - ret = read(fd, buffer, statbuf.st_size); + ret = read(fd, buffer, HINTFILE_MAX_SIZE); if (ret < 0) return -1; token = strtok_r(buffer, "\n", &pos1); do { http://git.mpich.org/mpich.git/commitdiff/bb7661e18a2842c879ad5bbd45509e1ae… commit bb7661e18a2842c879ad5bbd45509e1ae6264eb0 Author: Rob Latham <robl(a)mcs.anl.gov> Date: Tue Aug 12 18:58:30 2014 -0500 deferred open refinement: sync from only aggs There is no need for the non-aggregators to immediately open the file before calling sync -- if they have not opened the file, they will have no data to flush. Signed-off-by: Paul Coffman <pkcoff(a)us.ibm.com> diff --git a/src/mpi/romio/adio/common/ad_flush.c b/src/mpi/romio/adio/common/ad_flush.c index 61a9ed4..3ace677 100644 --- a/src/mpi/romio/adio/common/ad_flush.c +++ b/src/mpi/romio/adio/common/ad_flush.c @@ -16,16 +16,20 @@ void ADIOI_GEN_Flush(ADIO_File fd, int *error_code) int err; static char myname[] = "ADIOI_GEN_FLUSH"; - err = fsync(fd->fd_sys); - /* --BEGIN ERROR HANDLING-- */ - if (err == -1) { - *error_code = MPIO_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, - myname, __LINE__, MPI_ERR_IO, - "**io", - "**io %s", strerror(errno)); - return; + /* the deferred-open optimization may mean that a file has not been opened + * on this processor */ + if (fd->is_open > 0) { + err = fsync(fd->fd_sys); + /* --BEGIN ERROR HANDLING-- */ + if (err == -1) { + *error_code = MPIO_Err_create_code(MPI_SUCCESS, MPIR_ERR_RECOVERABLE, + myname, __LINE__, MPI_ERR_IO, + "**io", + "**io %s", strerror(errno)); + return; + } + /* --END ERROR HANDLING-- */ } - /* --END ERROR HANDLING-- */ *error_code = MPI_SUCCESS; } diff --git a/src/mpi/romio/mpi-io/fsync.c b/src/mpi/romio/mpi-io/fsync.c index d9ffe3f..0e4f1b9 100644 --- a/src/mpi/romio/mpi-io/fsync.c +++ b/src/mpi/romio/mpi-io/fsync.c @@ -60,8 +60,6 @@ int MPI_File_sync(MPI_File fh) MPIO_CHECK_WRITABLE(fh, myname, error_code); /* --END ERROR HANDLING-- */ - ADIOI_TEST_DEFERRED(adio_fh, "MPI_File_sync", &error_code); - ADIO_Flush(adio_fh, &error_code); /* --BEGIN ERROR HANDLING-- */ if (error_code != MPI_SUCCESS) ----------------------------------------------------------------------- Summary of changes: src/mpi/romio/adio/common/ad_flush.c | 22 +++++++----- src/mpi/romio/adio/common/ad_init.c | 5 --- src/mpi/romio/adio/common/ad_open.c | 18 ++++++++++ src/mpi/romio/adio/common/system_hints.c | 54 +++++++++++++++++------------- src/mpi/romio/adio/include/adioi.h | 2 +- src/mpi/romio/mpi-io/fsync.c | 2 - 6 files changed, 63 insertions(+), 40 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-103-g6dff3b9
by noreply＠mpich.org 21 Aug '14

21 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via 6dff3b96066195508406bea51ee551060a4f6fad (commit) from d12700f614e37299752c7750a73c273fdb6bdfcc (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/6dff3b96066195508406bea51ee551060… commit 6dff3b96066195508406bea51ee551060a4f6fad Author: Pavan Balaji <balaji(a)anl.gov> Date: Thu Aug 21 15:24:05 2014 -0500 Fix state declarations in netmods. No reviewer. diff --git a/src/mpid/ch3/channels/nemesis/netmod/ib/ib_poll.c b/src/mpid/ch3/channels/nemesis/netmod/ib/ib_poll.c index 7523127..8c84026 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/ib/ib_poll.c +++ b/src/mpid/ch3/channels/nemesis/netmod/ib/ib_poll.c @@ -642,6 +642,9 @@ int MPID_nem_ib_handle_pkt_bh(MPIDI_VC_t * vc, MPID_Request * req, char *buf, MP int mpi_errno = MPI_SUCCESS; int complete = 0; + MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_IB_HANDLE_PKT_BH); + MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_IB_HANDLE_PKT_BH); + while (buflen && !complete) { MPID_IOV *iov; int n_iov; @@ -691,7 +694,7 @@ int MPID_nem_ib_handle_pkt_bh(MPIDI_VC_t * vc, MPID_Request * req, char *buf, MP } } fn_exit: - MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_IB_DRAIN_SCQ); + MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_IB_HANDLE_PKT_BH); return mpi_errno; fn_fail: goto fn_exit; @@ -1794,6 +1797,9 @@ int MPID_nem_ib_PktHandler_Put(MPIDI_VC_t * vc, MPIDI_CH3_Pkt_t * pkt, MPID_Win *win_ptr; + MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_IB_PKTHANDLER_PUT); + MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_IB_PKTHANDLER_PUT); + MPIU_Assert(put_pkt->target_win_handle != MPI_WIN_NULL); MPID_Win_get_ptr(put_pkt->target_win_handle, win_ptr); mpi_errno = MPIDI_CH3_Start_rma_op_target(win_ptr, put_pkt->flags); @@ -1911,6 +1917,9 @@ int MPID_nem_ib_PktHandler_Accumulate(MPIDI_VC_t * vc, MPI_Aint type_size; MPID_Win *win_ptr; + MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_IB_PKTHANDLER_ACCUMULATE); + MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_IB_PKTHANDLER_ACCUMULATE); + MPIU_Assert(accum_pkt->target_win_handle != MPI_WIN_NULL); MPID_Win_get_ptr(accum_pkt->target_win_handle, win_ptr); mpi_errno = MPIDI_CH3_Start_rma_op_target(win_ptr, accum_pkt->flags); @@ -2093,6 +2102,10 @@ int MPID_nem_ib_PktHandler_GetResp(MPIDI_VC_t * vc, MPID_nem_ib_rma_lmt_cookie_t *s_cookie_buf = (MPID_nem_ib_rma_lmt_cookie_t *) ((uint8_t *) pkt + sizeof(MPIDI_CH3_Pkt_t) + sizeof(MPIDI_CH3_Pkt_t)); + + MPIDI_STATE_DECL(MPID_STATE_MPID_NEM_IB_PKTHANDLER_GETRESP); + MPIDI_FUNC_ENTER(MPID_STATE_MPID_NEM_IB_PKTHANDLER_GETRESP); + MPID_Request_get_ptr(get_resp_pkt->request_handle, req); void *write_to_buf; diff --git a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c index 3e60d56..5371625 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c +++ b/src/mpid/ch3/channels/nemesis/netmod/mxm/mxm_send.c @@ -129,7 +129,7 @@ int MPID_nem_mxm_iStartContigMsg(MPIDI_VC_t * vc, void *hdr, MPIDI_msg_sz_t hdr_ fn_exit: *sreq_ptr = sreq; - MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_MX_ISTARTCONTIGMSG); + MPIDI_FUNC_EXIT(MPID_STATE_MPID_NEM_MXM_ISTARTCONTIGMSG); return mpi_errno; fn_fail: goto fn_exit; ----------------------------------------------------------------------- Summary of changes: src/mpid/ch3/channels/nemesis/netmod/ib/ib_poll.c | 15 ++++++++++++++- .../ch3/channels/nemesis/netmod/mxm/mxm_send.c | 2 +- 2 files changed, 15 insertions(+), 2 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-102-gd12700f
by noreply＠mpich.org 21 Aug '14

21 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via d12700f614e37299752c7750a73c273fdb6bdfcc (commit) via cf09bff52aa420c1aed6185f6fcfa9cf94b912ff (commit) via f58bd7ad372546cbc83fb67c767b218b1f4fe82a (commit) from c3ab4aee1256f18b7e7e791ba758c08431acc71c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/d12700f614e37299752c7750a73c273fd… commit d12700f614e37299752c7750a73c273fdb6bdfcc Author: Junchao Zhang <jczhang(a)mcs.anl.gov> Date: Wed Aug 20 18:58:50 2014 -0500 Added more F08 + TS29113 compiler capability checks Checks whether the compiler supports intrinsic storage_size() and non-bind(C) argument x in C_FUNLOC(x). Added them since IBM XLF 15.1 fails on these two tests. diff --git a/confdb/aclocal_fc.m4 b/confdb/aclocal_fc.m4 index 7b5fee1..870a5be 100644 --- a/confdb/aclocal_fc.m4 +++ b/confdb/aclocal_fc.m4 @@ -1180,11 +1180,21 @@ SUBROUTINE test1(buf, count, ierr) INTEGER, OPTIONAL :: ierr END SUBROUTINE -! Test procedure +! Test procedure type and non-bind(c) x in C_FUNCLOC(x) SUBROUTINE test2(func) + USE, INTRINSIC :: ISO_C_BINDING, ONLY : C_FUNLOC, C_FUNPTR PROCEDURE(user_func) :: func + TYPE(C_FUNPTR) :: errhandler_fn + errhandler_fn = C_FUNLOC(func) END SUBROUTINE +! Test intrinsic storage_size +SUBROUTINE test3(x, size) + CHARACTER, DIMENSION(..) :: x + INTEGER, INTENT(OUT) :: size + size = storage_size(x)/8 +END SUBROUTINE test3 + END MODULE !============================================== http://git.mpich.org/mpich.git/commitdiff/cf09bff52aa420c1aed6185f6fcfa9cf9… commit cf09bff52aa420c1aed6185f6fcfa9cf94b912ff Author: Junchao Zhang <jczhang(a)mcs.anl.gov> Date: Wed Aug 20 17:36:53 2014 -0500 Added asynchronous attribute to newcomm of MPI_Comm_idup It is in errata for MPI-3.0 diff --git a/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 b/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 index f5f59b6..306db6f 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 +++ b/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 @@ -605,7 +605,7 @@ function MPIR_Comm_idup_c(comm, newcomm, request) & use :: mpi_c_interface_types, only : c_Comm, c_Request implicit none integer(c_Comm), value, intent(in) :: comm - integer(c_Comm), intent(out) :: newcomm + integer(c_Comm), intent(out), asynchronous :: newcomm integer(c_Request), intent(out) :: request integer(c_int) :: ierror end function MPIR_Comm_idup_c diff --git a/src/binding/fortran/use_mpi_f08/mpi_f08.F90 b/src/binding/fortran/use_mpi_f08/mpi_f08.F90 index d5029ba..4b3cb9e 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_f08.F90 +++ b/src/binding/fortran/use_mpi_f08/mpi_f08.F90 @@ -1446,7 +1446,7 @@ interface MPI_Comm_idup use :: mpi_f08_types, only : MPI_Comm, MPI_Request implicit none type(MPI_Comm), intent(in) :: comm - type(MPI_Comm), intent(out) :: newcomm + type(MPI_Comm), intent(out), asynchronous :: newcomm type(MPI_Request), intent(out) :: request integer, optional, intent(out) :: ierror end subroutine MPI_Comm_idup_f08 http://git.mpich.org/mpich.git/commitdiff/f58bd7ad372546cbc83fb67c767b218b1… commit f58bd7ad372546cbc83fb67c767b218b1f4fe82a Author: Junchao Zhang <jczhang(a)mcs.anl.gov> Date: Tue Aug 19 16:04:13 2014 -0500 Add some missing subroutines in the F08 binding diff --git a/src/binding/fortran/use_mpi_f08/mpi_c_interface_cdesc.F90 b/src/binding/fortran/use_mpi_f08/mpi_c_interface_cdesc.F90 index b84aca1..9c4738a 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_c_interface_cdesc.F90 +++ b/src/binding/fortran/use_mpi_f08/mpi_c_interface_cdesc.F90 @@ -795,11 +795,45 @@ function MPIR_Accumulate_cdesc(origin_addr, origin_count, origin_datatype, targe integer(c_int) :: ierror end function MPIR_Accumulate_cdesc +function MPIR_Compare_and_swap_cdesc(origin_addr, compare_addr, result_addr, datatype, & + target_rank, target_disp, win) & + bind(C, name="MPIR_Compare_and_swap_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface_types, only : c_Datatype, c_Win + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), intent(in), asynchronous :: compare_addr + type(*), dimension(..), asynchronous :: result_addr + integer(c_Datatype), intent(in) :: datatype + integer(c_int), intent(in) :: target_rank + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Compare_and_swap_cdesc + +function MPIR_Fetch_and_op_cdesc(origin_addr, result_addr, datatype, target_rank, & + target_disp, op, win) & + bind(C, name="MPIR_Fetch_and_op_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Datatype, c_Op, c_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer(c_Datatype), intent(in) :: datatype + integer(c_int), intent(in) :: target_rank + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Op), intent(in) :: op + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Fetch_and_op_cdesc + function MPIR_Get_cdesc(origin_addr, origin_count, origin_datatype, target_rank, & target_disp, target_count, target_datatype, win) & bind(C, name="MPIR_Get_cdesc") result(ierror) - use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND use :: mpi_c_interface_types, only : c_Datatype, c_Win implicit none type(*), dimension(..) :: origin_addr @@ -811,6 +845,24 @@ function MPIR_Get_cdesc(origin_addr, origin_count, origin_datatype, target_rank, integer(c_int) :: ierror end function MPIR_Get_cdesc +function MPIR_Get_accumulate_cdesc(origin_addr, origin_count, origin_datatype, result_addr, & + result_count, result_datatype, target_rank, target_disp, & + target_count, target_datatype, op, win) & + bind(C, name="MPIR_Get_accumulate_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Datatype, c_Op, c_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer(c_int), intent(in) :: origin_count, result_count, target_rank, target_count + integer(c_Datatype), intent(in) :: origin_datatype, target_datatype, result_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Op), intent(in) :: op + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Get_accumulate_cdesc + function MPIR_Put_cdesc(origin_addr, origin_count, origin_datatype, target_rank, & target_disp, target_count, target_datatype, win) & bind(C, name="MPIR_Put_cdesc") result(ierror) @@ -827,20 +879,90 @@ function MPIR_Put_cdesc(origin_addr, origin_count, origin_datatype, target_rank, integer(c_int) :: ierror end function MPIR_Put_cdesc -function MPIR_Win_complete_f08(win) & - bind(C, name="MPIR_Win_complete_c") result(ierror) +function MPIR_Raccumulate_cdesc(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, op, win, request) & + bind(C, name="MPIR_Raccumulate_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Datatype, c_Op, c_Win, c_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + integer, intent(in) :: origin_count, target_rank, target_count + integer(c_Datatype), intent(in) :: origin_datatype, target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Op), intent(in) :: op + integer(c_Win), intent(in) :: win + integer(c_Request), intent(out) :: request + integer(c_int) :: ierror +end function MPIR_Raccumulate_cdesc + +function MPIR_Rget_cdesc(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, win, request) & + bind(C, name="MPIR_Rget_cdesc") result(ierror) use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Datatype, c_Win, c_Request use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), asynchronous :: origin_addr + integer, intent(in) :: origin_count, target_rank, target_count + integer(c_Datatype), intent(in) :: origin_datatype, target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Win), intent(in) :: win + integer(c_Request), intent(out) :: request + integer(c_int) :: ierror +end function MPIR_Rget_cdesc + +function MPIR_Rget_accumulate_cdesc(origin_addr, origin_count, origin_datatype, & + result_addr, result_count, result_datatype, target_rank, & + target_disp, target_count, target_datatype, op, win, request) & + bind(C, name="MPIR_Rget_accumulate_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Datatype, c_Op, c_Win, c_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer, intent(in) :: origin_count, result_count, target_rank, target_count + integer(c_Datatype), intent(in) :: origin_datatype, target_datatype, result_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Op), intent(in) :: op + integer(c_Win), intent(in) :: win + integer(c_Request), intent(out) :: request + integer(c_int) :: ierror +end function MPIR_Rget_accumulate_cdesc + +function MPIR_Rput_cdesc(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, win, request) & + bind(C, name="MPIR_Rput_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Datatype, c_Win, c_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + integer, intent(in) :: origin_count, target_rank, target_count + integer(c_Datatype), intent(in) :: origin_datatype, target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + integer(c_Win), intent(in) :: win + integer(c_Request), intent(out) :: request + integer(c_int) :: ierror +end function MPIR_Rput_cdesc + +function MPIR_Win_attach_cdesc(win, base, size) & + bind(C, name="MPIR_Win_attach_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int use :: mpi_c_interface_types, only : c_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND implicit none - integer(c_Win), value, intent(in) :: win + integer(c_Win), intent(in) :: win + type(*), dimension(..), asynchronous :: base + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size integer(c_int) :: ierror -end function MPIR_Win_complete_f08 +end function MPIR_Win_attach_cdesc function MPIR_Win_create_cdesc(base, size, disp_unit, info, comm, win) & bind(C, name="MPIR_Win_create_cdesc") result(ierror) - use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND use :: mpi_c_interface_types, only : c_Info, c_Comm, c_Win implicit none type(*), dimension(..) :: base @@ -852,7 +974,15 @@ function MPIR_Win_create_cdesc(base, size, disp_unit, info, comm, win) & integer(c_int) :: ierror end function MPIR_Win_create_cdesc - +function MPIR_Win_detach_cdesc(win, base) & + bind(C, name="MPIR_Win_detach_cdesc") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_Win), intent(in) :: win + type(*), dimension(..), asynchronous :: base + integer(c_int) :: ierror +end function MPIR_Win_detach_cdesc function MPIR_File_iread_cdesc(fh, buf, count, datatype, request) & bind(C, name="MPIR_File_iread_cdesc") result(ierror) diff --git a/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 b/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 index 11da8bf..f5f59b6 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 +++ b/src/binding/fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 @@ -750,6 +750,26 @@ function MPIR_Comm_test_inter_c(comm, flag) & integer(c_int) :: ierror end function MPIR_Comm_test_inter_c +function MPIR_Comm_get_info_c(comm, info_used) & + bind(C, name="PMPI_Comm_get_info") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Comm, c_Info + implicit none + integer(c_Comm), intent(in) :: comm + integer(c_Info), intent(out) :: info_used + integer(c_int) :: ierror +end function MPIR_Comm_get_info_c + +function MPIR_Comm_set_info_c(comm, info) & + bind(C, name="PMPI_Comm_set_info") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Comm, c_Info + implicit none + integer(c_Comm), intent(in) :: comm + integer(c_Info), intent(in) :: info + integer(c_int) :: ierror +end function MPIR_Comm_set_info_c + function MPIR_Group_compare_c(group1,group2,result) & bind(C, name="PMPI_Group_compare") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1761,6 +1781,36 @@ function MPIR_Unpublish_name_c(service_name, info, port_name) & integer(c_int) :: ierror end function MPIR_Unpublish_name_c +function MPIR_Win_allocate_c(size, disp_unit, info, comm, baseptr, win) & + bind(C, name="PMPI_Win_allocate") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + use :: mpi_c_interface_types, only : c_Info, c_Comm, c_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer(c_int), intent(in) :: disp_unit + integer(c_Info), intent(in) :: info + integer(c_Comm), intent(in) :: comm + type(c_ptr), intent(out) :: baseptr + integer(c_Win), intent(out) :: win + integer(c_int) :: ierror +end function MPIR_Win_allocate_c + +function MPIR_Win_allocate_shared_c(size, disp_unit, info, comm, baseptr, win) & + bind(C, name="PMPI_Win_allocate_shared") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + use :: mpi_c_interface_types, only : c_Info, c_Comm, c_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer(c_int), intent(in) :: disp_unit + integer(c_Info), intent(in) :: info + integer(c_Comm), intent(in) :: comm + type(c_ptr), intent(out) :: baseptr + integer(c_Win), intent(out) :: win + integer(c_int) :: ierror +end function MPIR_Win_allocate_shared_c + function MPIR_Win_complete_c(win) & bind(C, name="PMPI_Win_complete") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1770,6 +1820,17 @@ function MPIR_Win_complete_c(win) & integer(c_int) :: ierror end function MPIR_Win_complete_c +function MPIR_Win_create_dynamic_c(info, comm, win) & + bind(C, name="PMPI_Win_create_dynamic") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Info, c_Comm, c_Win + implicit none + integer(c_Info), intent(in) :: info + integer(c_Comm), intent(in) :: comm + integer(c_Win), intent(out) :: win + integer(c_int) :: ierror +end function MPIR_Win_create_dynamic_c + function MPIR_Win_fence_c(assert, win) & bind(C, name="PMPI_Win_fence") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1780,6 +1841,44 @@ function MPIR_Win_fence_c(assert, win) & integer(c_int) :: ierror end function MPIR_Win_fence_c +function MPIR_Win_flush_c(rank, win) & + bind(C, name="PMPI_Win_flush") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_int), intent(in) :: rank + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_flush_c + +function MPIR_Win_flush_all_c(win) & + bind(C, name="PMPI_Win_flush_all") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_flush_all_c + +function MPIR_Win_flush_local_c(rank, win) & + bind(C, name="PMPI_Win_flush_local") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_int), intent(in) :: rank + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_flush_local_c + +function MPIR_Win_flush_local_all_c(win) & + bind(C, name="PMPI_Win_flush_local_all") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_flush_local_all_c + function MPIR_Win_free_c(win) & bind(C, name="PMPI_Win_free") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1799,6 +1898,16 @@ function MPIR_Win_get_group_c(win, group) & integer(c_int) :: ierror end function MPIR_Win_get_group_c +function MPIR_Win_get_info_c(win, info_used) & + bind(C, name="PMPI_Win_get_info") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win, c_Info + implicit none + integer(c_Win), intent(in) :: win + integer(c_Info), intent(out) :: info_used + integer(c_int) :: ierror +end function MPIR_Win_get_info_c + function MPIR_Win_lock_c(lock_type, rank, assert, win) & bind(C, name="PMPI_Win_lock") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1809,6 +1918,16 @@ function MPIR_Win_lock_c(lock_type, rank, assert, win) & integer(c_int) :: ierror end function MPIR_Win_lock_c +function MPIR_Win_lock_all_c(assert, win) & + bind(C, name="PMPI_Win_lock_all") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_int), intent(in) :: assert + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_lock_all_c + function MPIR_Win_post_c(group, assert, win) & bind(C, name="PMPI_Win_post") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1820,6 +1939,30 @@ function MPIR_Win_post_c(group, assert, win) & integer(c_int) :: ierror end function MPIR_Win_post_c +function MPIR_Win_set_info_c(win, info) & + bind(C, name="PMPI_Win_set_info") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win, c_Info + implicit none + integer(c_Win), intent(in) :: win + integer(c_Info), intent(in) :: info + integer(c_int) :: ierror +end function MPIR_Win_set_info_c + +function MPIR_Win_shared_query_c(win, rank, size, disp_unit, baseptr) & + bind(C, name="PMPI_Win_shared_query") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + use :: mpi_c_interface_types, only : c_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + integer(c_Win), intent(in) :: win + integer(c_int), intent(in) :: rank + integer(kind=MPI_ADDRESS_KIND), intent(out) :: size + integer(c_int), intent(out) :: disp_unit + type(c_ptr), intent(out) :: baseptr + integer(c_int) :: ierror +end function MPIR_Win_shared_query_c + function MPIR_Win_start_c(group, assert, win) & bind(C, name="PMPI_Win_start") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1831,6 +1974,15 @@ function MPIR_Win_start_c(group, assert, win) & integer(c_int) :: ierror end function MPIR_Win_start_c +function MPIR_Win_sync_c(win) & + bind(C, name="PMPI_Win_sync") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_sync_c + function MPIR_Win_test_c(win, flag) & bind(C, name="PMPI_Win_test") result(ierror) use, intrinsic :: iso_c_binding, only : c_int @@ -1851,6 +2003,15 @@ function MPIR_Win_unlock_c(rank, win) & integer(c_int) :: ierror end function MPIR_Win_unlock_c +function MPIR_Win_unlock_all_c(win) & + bind(C, name="PMPI_Win_unlock_all") result(ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface_types, only : c_Win + implicit none + integer(c_Win), intent(in) :: win + integer(c_int) :: ierror +end function MPIR_Win_unlock_all_c + function MPIR_Win_wait_c(win) & bind(C, name="PMPI_Win_wait") result(ierror) use, intrinsic :: iso_c_binding, only : c_int diff --git a/src/binding/fortran/use_mpi_f08/mpi_f08.F90 b/src/binding/fortran/use_mpi_f08/mpi_f08.F90 index 2fef1a4..d5029ba 100644 --- a/src/binding/fortran/use_mpi_f08/mpi_f08.F90 +++ b/src/binding/fortran/use_mpi_f08/mpi_f08.F90 @@ -1482,6 +1482,16 @@ interface MPI_Comm_get_attr end subroutine MPI_Comm_get_attr_f08 end interface MPI_Comm_get_attr +interface MPI_Comm_get_info + subroutine MPI_Comm_get_info_f08(comm, info_used, ierror) + use :: mpi_f08_types, only : MPI_Comm, MPI_Info + implicit none + type(MPI_Comm), intent(in) :: comm + type(MPI_Info), intent(out) :: info_used + integer, optional, intent(out) :: ierror + end subroutine MPI_Comm_get_info_f08 +end interface MPI_Comm_get_info + interface MPI_Comm_get_name subroutine MPI_Comm_get_name_f08(comm, comm_name, resultlen, ierror) use :: mpi_f08_types, only : MPI_Comm @@ -1546,6 +1556,16 @@ interface MPI_Comm_set_attr end subroutine MPI_Comm_set_attr_f08 end interface MPI_Comm_set_attr +interface MPI_Comm_set_info + subroutine MPI_Comm_set_info_f08(comm, info_used, ierror) + use :: mpi_f08_types, only : MPI_Comm, MPI_Info + implicit none + type(MPI_Comm), intent(in) :: comm + type(MPI_Info), intent(in) :: info_used + integer, optional, intent(out) :: ierror + end subroutine MPI_Comm_set_info_f08 +end interface MPI_Comm_set_info + interface MPI_Comm_set_name subroutine MPI_Comm_set_name_f08(comm, comm_name, ierror) use :: mpi_f08_types, only : MPI_Comm @@ -2634,6 +2654,40 @@ interface MPI_Accumulate end subroutine MPI_Accumulate_f08ts end interface MPI_Accumulate +interface MPI_Compare_and_swap + subroutine MPI_Compare_and_swap_f08ts(origin_addr, compare_addr, result_addr, datatype, & + target_rank, target_disp, win, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), intent(in), asynchronous :: compare_addr + type(*), dimension(..), asynchronous :: result_addr + type(MPI_Datatype), intent(in) :: datatype + integer, intent(in) :: target_rank + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Compare_and_swap_f08ts +end interface MPI_Compare_and_swap + +interface MPI_Fetch_and_op + subroutine MPI_Fetch_and_op_f08ts(origin_addr, result_addr, datatype, target_rank, & + target_disp, op, win, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + type(MPI_Datatype), intent(in) :: datatype + integer, intent(in) :: target_rank + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Fetch_and_op_f08ts +end interface MPI_Fetch_and_op + interface MPI_Get subroutine MPI_Get_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & target_disp, target_count, target_datatype, win, ierror) @@ -2650,6 +2704,24 @@ interface MPI_Get end subroutine MPI_Get_f08ts end interface MPI_Get +interface MPI_Get_accumulate + subroutine MPI_Get_accumulate_f08ts(origin_addr, origin_count, origin_datatype, result_addr, & + result_count, result_datatype, target_rank, target_disp, & + target_count, target_datatype, op, win, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer, intent(in) :: origin_count, result_count, target_rank, target_count + type(MPI_Datatype), intent(in) :: origin_datatype, target_datatype, result_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Get_accumulate_f08ts +end interface MPI_Get_accumulate + interface MPI_Put subroutine MPI_Put_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & target_disp, target_count, target_datatype, win, ierror) @@ -2666,6 +2738,119 @@ interface MPI_Put end subroutine MPI_Put_f08ts end interface MPI_Put +interface MPI_Raccumulate + subroutine MPI_Raccumulate_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, op, win, request, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + integer, intent(in) :: origin_count, target_rank, target_count + type(MPI_Datatype), intent(in) :: origin_datatype, target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + end subroutine MPI_Raccumulate_f08ts +end interface MPI_Raccumulate + +interface MPI_Rget + subroutine MPI_Rget_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, win, request, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), asynchronous :: origin_addr + integer, intent(in) :: origin_count, target_rank, target_count + type(MPI_Datatype), intent(in) :: origin_datatype, target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + end subroutine MPI_Rget_f08ts +end interface MPI_Rget + +interface MPI_Rget_accumulate + subroutine MPI_Rget_accumulate_f08ts(origin_addr, origin_count, origin_datatype, & + result_addr, result_count, result_datatype, target_rank, & + target_disp, target_count, target_datatype, op, win, request, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer, intent(in) :: origin_count, result_count, target_rank, target_count + type(MPI_Datatype), intent(in) :: origin_datatype, target_datatype, result_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + end subroutine MPI_Rget_accumulate_f08ts +end interface MPI_Rget_accumulate + +interface MPI_Rput + subroutine MPI_Rput_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, win, request, ierror) + use :: mpi_f08_types, only : MPI_Datatype, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(*), dimension(..), intent(in), asynchronous :: origin_addr + integer, intent(in) :: origin_count, target_rank, target_count + type(MPI_Datatype), intent(in) :: origin_datatype, target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + end subroutine MPI_Rput_f08ts +end interface MPI_Rput + +interface MPI_Win_allocate + subroutine MPI_Win_allocate_f08(size, disp_unit, info, comm, baseptr, win, ierror) + use, intrinsic :: iso_c_binding, only : c_ptr + use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer, intent(in) :: disp_unit + type(MPI_Info), intent(in) :: info + type(MPI_Comm), intent(in) :: comm + type(c_ptr), intent(out) :: baseptr + type(MPI_Win), intent(out) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_allocate_f08 +end interface MPI_Win_allocate + +interface MPI_Win_allocate_shared + subroutine MPI_Win_allocate_shared_f08(size, disp_unit, info, comm, baseptr, win, ierror) + use, intrinsic :: iso_c_binding, only : c_ptr + use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer, intent(in) :: disp_unit + type(MPI_Info), intent(in) :: info + type(MPI_Comm), intent(in) :: comm + type(c_ptr), intent(out) :: baseptr + type(MPI_Win), intent(out) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_allocate_shared_f08 +end interface MPI_Win_allocate_shared + +interface MPI_Win_attach + subroutine MPI_Win_attach_f08ts(win, base, size, ierror) + use :: mpi_f08_types, only : MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(MPI_Win), intent(in) :: win + type(*), dimension(..), asynchronous :: base + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_attach_f08ts +end interface MPI_Win_attach + + interface MPI_Win_complete subroutine MPI_Win_complete_f08(win, ierror) use :: mpi_f08_types, only : MPI_Win @@ -2690,6 +2875,27 @@ interface MPI_Win_create end subroutine MPI_Win_create_f08ts end interface MPI_Win_create +interface MPI_Win_create_dynamic + subroutine MPI_Win_create_dynamic_f08(info, comm, win, ierror) + use :: mpi_f08_types, only : MPI_Info, MPI_Comm, MPI_Win + implicit none + type(MPI_Info), intent(in) :: info + type(MPI_Comm), intent(in) :: comm + type(MPI_Win), intent(out) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_create_dynamic_f08 +end interface MPI_Win_create_dynamic + +interface MPI_Win_detach + subroutine MPI_Win_detach_f08ts(win, base, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + type(MPI_Win), intent(in) :: win + type(*), dimension(..), asynchronous :: base + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_detach_f08ts +end interface MPI_Win_detach + interface MPI_Win_fence subroutine MPI_Win_fence_f08(assert, win, ierror) use :: mpi_f08_types, only : MPI_Win @@ -2700,6 +2906,44 @@ interface MPI_Win_fence end subroutine MPI_Win_fence_f08 end interface MPI_Win_fence +interface MPI_Win_flush + subroutine MPI_Win_flush_f08(rank, win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + integer, intent(in) :: rank + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_flush_f08 +end interface MPI_Win_flush + +interface MPI_Win_flush_all + subroutine MPI_Win_flush_all_f08(win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_flush_all_f08 +end interface MPI_Win_flush_all + +interface MPI_Win_flush_local + subroutine MPI_Win_flush_local_f08(rank, win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + integer, intent(in) :: rank + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_flush_local_f08 +end interface MPI_Win_flush_local + +interface MPI_Win_flush_local_all + subroutine MPI_Win_flush_local_all_f08(win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_flush_local_all_f08 +end interface MPI_Win_flush_local_all + interface MPI_Win_free subroutine MPI_Win_free_f08(win, ierror) use :: mpi_f08_types, only : MPI_Win @@ -2719,6 +2963,16 @@ interface MPI_Win_get_group end subroutine MPI_Win_get_group_f08 end interface MPI_Win_get_group +interface MPI_Win_get_info + subroutine MPI_Win_get_info_f08(win, info_used, ierror) + use :: mpi_f08_types, only : MPI_Win, MPI_Info + implicit none + type(MPI_Win), intent(in) :: win + type(MPI_Info), intent(out) :: info_used + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_get_info_f08 +end interface MPI_Win_get_info + interface MPI_Win_lock subroutine MPI_Win_lock_f08(lock_type, rank, assert, win, ierror) use :: mpi_f08_types, only : MPI_Win @@ -2729,6 +2983,16 @@ interface MPI_Win_lock end subroutine MPI_Win_lock_f08 end interface MPI_Win_lock +interface MPI_Win_lock_all + subroutine MPI_Win_lock_all_f08(assert, win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + integer, intent(in) :: assert + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_lock_all_f08 +end interface MPI_Win_lock_all + interface MPI_Win_post subroutine MPI_Win_post_f08(group, assert, win, ierror) use :: mpi_f08_types, only : MPI_Group, MPI_Win @@ -2740,6 +3004,31 @@ interface MPI_Win_post end subroutine MPI_Win_post_f08 end interface MPI_Win_post +interface MPI_Win_set_info + subroutine MPI_Win_set_info_f08(win, info, ierror) + use :: mpi_f08_types, only : MPI_Win, MPI_info + implicit none + type(MPI_Win), intent(in) :: win + type(MPI_Info), intent(in) :: info + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_set_info_f08 +end interface MPI_Win_set_info + +interface MPI_Win_shared_query + subroutine MPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr, ierror) + use, intrinsic :: iso_c_binding, only : c_ptr + use :: mpi_f08_types, only : MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + implicit none + type(MPI_Win), intent(in) :: win + integer, intent(in) :: rank + integer(kind=MPI_ADDRESS_KIND), intent(out) :: size + integer, intent(out) :: disp_unit + type(c_ptr), intent(out) :: baseptr + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_shared_query_f08 +end interface MPI_Win_shared_query + interface MPI_Win_start subroutine MPI_Win_start_f08(group, assert, win, ierror) use :: mpi_f08_types, only : MPI_Group, MPI_Win @@ -2751,6 +3040,15 @@ interface MPI_Win_start end subroutine MPI_Win_start_f08 end interface MPI_Win_start +interface MPI_Win_sync + subroutine MPI_Win_sync_f08(win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_sync_f08 +end interface MPI_Win_sync + interface MPI_Win_test subroutine MPI_Win_test_f08(win, flag, ierror) use :: mpi_f08_types, only : MPI_Win @@ -2771,6 +3069,15 @@ interface MPI_Win_unlock end subroutine MPI_Win_unlock_f08 end interface MPI_Win_unlock +interface MPI_Win_unlock_all + subroutine MPI_Win_unlock_all_f08(win, ierror) + use :: mpi_f08_types, only : MPI_Win + implicit none + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + end subroutine MPI_Win_unlock_all_f08 +end interface MPI_Win_unlock_all + interface MPI_Win_wait subroutine MPI_Win_wait_f08(win, ierror) use :: mpi_f08_types, only : MPI_Win diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/comm_get_info_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/comm_get_info_f08ts.F90 new file mode 100644 index 0000000..88614c2 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/comm_get_info_f08ts.F90 @@ -0,0 +1,32 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Comm_get_info_f08(comm, info_used, ierror) + use :: mpi_f08, only : MPI_Comm, MPI_Info + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface, only : c_Comm, c_Info + use :: mpi_c_interface, only : MPIR_Comm_get_info_c + + implicit none + + type(MPI_Comm), intent(in) :: comm + type(MPI_Info), intent(out) :: info_used + integer, optional, intent(out) :: ierror + + integer(c_Comm) :: comm_c + integer(c_Info) :: info_used_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Comm_get_info_c(comm%MPI_VAL, info_used%MPI_VAL) + else + comm_c = comm%MPI_VAL + ierror_c = MPIR_Comm_get_info_c(comm_c, info_used_c) + info_used%MPI_VAL = info_used_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Comm_get_info_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/comm_set_info_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/comm_set_info_f08ts.F90 new file mode 100644 index 0000000..9e31ff0 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/comm_set_info_f08ts.F90 @@ -0,0 +1,32 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Comm_set_info_f08(comm, info_used, ierror) + use :: mpi_f08, only : MPI_Comm, MPI_Info + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_c_interface, only : c_Comm, c_Info + use :: mpi_c_interface, only : MPIR_Comm_set_info_c + + implicit none + + type(MPI_Comm), intent(in) :: comm + type(MPI_Info), intent(in) :: info_used + integer, optional, intent(out) :: ierror + + integer(c_Comm) :: comm_c + integer(c_Info) :: info_used_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Comm_set_info_c(comm%MPI_VAL, info_used%MPI_VAL) + else + comm_c = comm%MPI_VAL + info_used_c = info_used%MPI_VAL + ierror_c = MPIR_Comm_set_info_c(comm_c, info_used_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Comm_set_info_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/compare_and_swap_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/compare_and_swap_f08ts.F90 new file mode 100644 index 0000000..3cc06fc --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/compare_and_swap_f08ts.F90 @@ -0,0 +1,43 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Compare_and_swap_f08ts(origin_addr, compare_addr, result_addr, datatype, & + target_rank, target_disp, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Win + use :: mpi_c_interface, only : MPIR_Compare_and_swap_cdesc + + implicit none + + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), intent(in), asynchronous :: compare_addr + type(*), dimension(..), asynchronous :: result_addr + type(MPI_Datatype), intent(in) :: datatype + integer, intent(in) :: target_rank + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Datatype) :: datatype_c + integer(c_int) :: target_rank_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Compare_and_swap_cdesc(origin_addr, compare_addr, result_addr, datatype%MPI_VAL, & + target_rank, target_disp, win%MPI_VAL) + else + datatype_c = datatype%MPI_VAL + target_rank_c = target_rank + win_c = win%MPI_VAL + ierror_c = MPIR_Compare_and_swap_cdesc(origin_addr, compare_addr, result_addr, datatype_c, & + target_rank_c, target_disp, win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Compare_and_swap_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/fetch_and_op_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/fetch_and_op_f08ts.F90 new file mode 100644 index 0000000..c72abd7 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/fetch_and_op_f08ts.F90 @@ -0,0 +1,45 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Fetch_and_op_f08ts(origin_addr, result_addr, datatype, target_rank, & + target_disp, op, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Op, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Op, c_Win + use :: mpi_c_interface, only : MPIR_Fetch_and_op_cdesc + + implicit none + + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + type(MPI_Datatype), intent(in) :: datatype + integer, intent(in) :: target_rank + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Datatype) :: datatype_c + integer(c_int) :: target_rank_c + integer(c_Op) :: op_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Fetch_and_op_cdesc(origin_addr, result_addr, datatype%MPI_VAL, target_rank, target_disp, & + op%MPI_VAL, win%MPI_VAL) + else + datatype_c = datatype%MPI_VAL + target_rank_c = target_rank + op_c = op%MPI_VAL + win_c = win%MPI_VAL + ierror_c = MPIR_Fetch_and_op_cdesc(origin_addr, result_addr, datatype_c, target_rank_c, target_disp, & + op_c, win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Fetch_and_op_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/get_accumulate_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/get_accumulate_f08ts.F90 new file mode 100644 index 0000000..65ce354 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/get_accumulate_f08ts.F90 @@ -0,0 +1,63 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Get_accumulate_f08ts(origin_addr, origin_count, origin_datatype, result_addr, & + result_count, result_datatype, target_rank, target_disp, & + target_count, target_datatype, op, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Op, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Op, c_Win + use :: mpi_c_interface, only : MPIR_Get_accumulate_cdesc + + implicit none + + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer, intent(in) :: origin_count + integer, intent(in) :: result_count + integer, intent(in) :: target_rank + integer, intent(in) :: target_count + type(MPI_Datatype), intent(in) :: origin_datatype + type(MPI_Datatype), intent(in) :: target_datatype + type(MPI_Datatype), intent(in) :: result_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_int) :: origin_count_c + integer(c_int) :: result_count_c + integer(c_int) :: target_rank_c + integer(c_int) :: target_count_c + integer(c_Datatype) :: origin_datatype_c + integer(c_Datatype) :: target_datatype_c + integer(c_Datatype) :: result_datatype_c + integer(c_Op) :: op_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Get_accumulate_cdesc(origin_addr, origin_count, origin_datatype%MPI_VAL, result_addr, & + result_count, result_datatype%MPI_VAL, target_rank, target_disp, target_count, target_datatype%MPI_VAL, & + op%MPI_VAL, win%MPI_VAL) + else + origin_count_c = origin_count + origin_datatype_c = origin_datatype%MPI_VAL + result_count_c = result_count + result_datatype_c = result_datatype%MPI_VAL + target_rank_c = target_rank + target_count_c = target_count + target_datatype_c = target_datatype%MPI_VAL + op_c = op%MPI_VAL + win_c = win%MPI_VAL + ierror_c = MPIR_Get_accumulate_cdesc(origin_addr, origin_count_c, origin_datatype_c, result_addr, & + result_count_c, result_datatype_c, target_rank_c, target_disp, target_count_c, target_datatype_c, & + op_c, win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Get_accumulate_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/raccumulate_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/raccumulate_f08ts.F90 new file mode 100644 index 0000000..042f042 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/raccumulate_f08ts.F90 @@ -0,0 +1,56 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Raccumulate_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, op, win, request, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Op, c_Win, c_Request + use :: mpi_c_interface, only : MPIR_Raccumulate_cdesc + + implicit none + + type(*), dimension(..), intent(in), asynchronous :: origin_addr + integer, intent(in) :: origin_count + integer, intent(in) :: target_rank + integer, intent(in) :: target_count + type(MPI_Datatype), intent(in) :: origin_datatype + type(MPI_Datatype), intent(in) :: target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + + integer :: origin_count_c + integer :: target_rank_c + integer :: target_count_c + integer(c_Datatype) :: origin_datatype_c + integer(c_Datatype) :: target_datatype_c + integer(c_Op) :: op_c + integer(c_Win) :: win_c + integer(c_Request) :: request_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Raccumulate_cdesc(origin_addr, origin_count, origin_datatype%MPI_VAL, target_rank, & + target_disp, target_count, target_datatype%MPI_VAL, op%MPI_VAL, win%MPI_VAL, request%MPI_VAL) + else + origin_count_c = origin_count + origin_datatype_c = origin_datatype%MPI_VAL + target_rank_c = target_rank + target_count_c = target_count + target_datatype_c = target_datatype%MPI_VAL + op_c = op%MPI_VAL + win_c = win%MPI_VAL + ierror_c = MPIR_Raccumulate_cdesc(origin_addr, origin_count_c, origin_datatype_c, target_rank_c, & + target_disp, target_count_c, target_datatype_c, op_c, win_c, request_c) + request%MPI_VAL = request_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Raccumulate_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/rget_accumulate_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/rget_accumulate_f08ts.F90 new file mode 100644 index 0000000..f041697 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/rget_accumulate_f08ts.F90 @@ -0,0 +1,66 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Rget_accumulate_f08ts(origin_addr, origin_count, origin_datatype, & + result_addr, result_count, result_datatype, target_rank, & + target_disp, target_count, target_datatype, op, win, request, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Op, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Op, c_Win, c_Request + use :: mpi_c_interface, only : MPIR_Rget_accumulate_cdesc + + implicit none + + type(*), dimension(..), intent(in), asynchronous :: origin_addr + type(*), dimension(..), asynchronous :: result_addr + integer, intent(in) :: origin_count + integer, intent(in) :: result_count + integer, intent(in) :: target_rank + integer, intent(in) :: target_count + type(MPI_Datatype), intent(in) :: origin_datatype + type(MPI_Datatype), intent(in) :: target_datatype + type(MPI_Datatype), intent(in) :: result_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Op), intent(in) :: op + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + + integer :: origin_count_c + integer :: result_count_c + integer :: target_rank_c + integer :: target_count_c + integer(c_Datatype) :: origin_datatype_c + integer(c_Datatype) :: target_datatype_c + integer(c_Datatype) :: result_datatype_c + integer(c_Op) :: op_c + integer(c_Win) :: win_c + integer(c_Request) :: request_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Rget_accumulate_cdesc(origin_addr, origin_count, origin_datatype%MPI_VAL, result_addr, & + result_count, result_datatype%MPI_VAL, target_rank, target_disp, target_count, target_datatype%MPI_VAL, & + op%MPI_VAL, win%MPI_VAL, request%MPI_VAL) + else + origin_count_c = origin_count + origin_datatype_c = origin_datatype%MPI_VAL + result_count_c = result_count + result_datatype_c = result_datatype%MPI_VAL + target_rank_c = target_rank + target_count_c = target_count + target_datatype_c = target_datatype%MPI_VAL + op_c = op%MPI_VAL + win_c = win%MPI_VAL + ierror_c = MPIR_Rget_accumulate_cdesc(origin_addr, origin_count_c, origin_datatype_c, result_addr, & + result_count_c, result_datatype_c, target_rank_c, target_disp, target_count_c, target_datatype_c, & + op_c, win_c, request_c) + request%MPI_VAL = request_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Rget_accumulate_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/rget_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/rget_f08ts.F90 new file mode 100644 index 0000000..5709e24 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/rget_f08ts.F90 @@ -0,0 +1,53 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Rget_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, win, request, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Win, c_Request + use :: mpi_c_interface, only : MPIR_Rget_cdesc + + implicit none + + type(*), dimension(..), asynchronous :: origin_addr + integer, intent(in) :: origin_count + integer, intent(in) :: target_rank + integer, intent(in) :: target_count + type(MPI_Datatype), intent(in) :: origin_datatype + type(MPI_Datatype), intent(in) :: target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + + integer :: origin_count_c + integer :: target_rank_c + integer :: target_count_c + integer(c_Datatype) :: origin_datatype_c + integer(c_Datatype) :: target_datatype_c + integer(c_Win) :: win_c + integer(c_Request) :: request_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Rget_cdesc(origin_addr, origin_count, origin_datatype%MPI_VAL, target_rank, target_disp, & + target_count, target_datatype%MPI_VAL, win%MPI_VAL, request%MPI_VAL) + else + origin_count_c = origin_count + origin_datatype_c = origin_datatype%MPI_VAL + target_rank_c = target_rank + target_count_c = target_count + target_datatype_c = target_datatype%MPI_VAL + win_c = win%MPI_VAL + ierror_c = MPIR_Rget_cdesc(origin_addr, origin_count_c, origin_datatype_c, target_rank_c, target_disp, & + target_count_c, target_datatype_c, win_c, request_c) + request%MPI_VAL = request_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Rget_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/rput_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/rput_f08ts.F90 new file mode 100644 index 0000000..547a584 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/rput_f08ts.F90 @@ -0,0 +1,53 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Rput_f08ts(origin_addr, origin_count, origin_datatype, target_rank, & + target_disp, target_count, target_datatype, win, request, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Datatype, MPI_Win, MPI_Request + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Datatype, c_Win, c_Request + use :: mpi_c_interface, only : MPIR_Rput_cdesc + + implicit none + + type(*), dimension(..), intent(in), asynchronous :: origin_addr + integer, intent(in) :: origin_count + integer, intent(in) :: target_rank + integer, intent(in) :: target_count + type(MPI_Datatype), intent(in) :: origin_datatype + type(MPI_Datatype), intent(in) :: target_datatype + integer(kind=MPI_ADDRESS_KIND), intent(in) :: target_disp + type(MPI_Win), intent(in) :: win + type(MPI_Request), intent(out) :: request + integer, optional, intent(out) :: ierror + + integer :: origin_count_c + integer :: target_rank_c + integer :: target_count_c + integer(c_Datatype) :: origin_datatype_c + integer(c_Datatype) :: target_datatype_c + integer(c_Win) :: win_c + integer(c_Request) :: request_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Rput_cdesc(origin_addr, origin_count, origin_datatype%MPI_VAL, target_rank, target_disp, & + target_count, target_datatype%MPI_VAL, win%MPI_VAL, request%MPI_VAL) + else + origin_count_c = origin_count + origin_datatype_c = origin_datatype%MPI_VAL + target_rank_c = target_rank + target_count_c = target_count + target_datatype_c = target_datatype%MPI_VAL + win_c = win%MPI_VAL + ierror_c = MPIR_Rput_cdesc(origin_addr, origin_count_c, origin_datatype_c, target_rank_c, target_disp, & + target_count_c, target_datatype_c, win_c, request_c) + request%MPI_VAL = request_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Rput_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_f08ts.F90 new file mode 100644 index 0000000..462e25f --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_f08ts.F90 @@ -0,0 +1,43 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_allocate_f08(size, disp_unit, info, comm, baseptr, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + use :: mpi_f08, only : MPI_Info, MPI_Comm, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Info, c_Comm, c_Win + use :: mpi_c_interface, only : MPIR_Win_allocate_c + + implicit none + + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer, intent(in) :: disp_unit + type(MPI_Info), intent(in) :: info + type(MPI_Comm), intent(in) :: comm + type(c_ptr), intent(out) :: baseptr + type(MPI_Win), intent(out) :: win + integer, optional, intent(out) :: ierror + + integer(c_int) :: disp_unit_c + integer(c_Info) :: info_c + integer(c_Comm) :: comm_c + type(c_ptr) :: baseptr_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_allocate_c(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL) + else + disp_unit_c = disp_unit + info_c = info%MPI_VAL + comm_c = comm%MPI_VAL + ierror_c = MPIR_Win_allocate_c(size, disp_unit_c, info_c, comm_c, baseptr_c, win_c) + baseptr = baseptr_c + win%MPI_VAL = win_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_allocate_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_shared_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_shared_f08ts.F90 new file mode 100644 index 0000000..29cede7 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_shared_f08ts.F90 @@ -0,0 +1,43 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_allocate_shared_f08(size, disp_unit, info, comm, baseptr, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + use :: mpi_f08, only : MPI_Info, MPI_Comm, MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Info, c_Comm, c_Win + use :: mpi_c_interface, only : MPIR_Win_allocate_shared_c + + implicit none + + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer, intent(in) :: disp_unit + type(MPI_Info), intent(in) :: info + type(MPI_Comm), intent(in) :: comm + type(c_ptr), intent(out) :: baseptr + type(MPI_Win), intent(out) :: win + integer, optional, intent(out) :: ierror + + integer(c_int) :: disp_unit_c + integer(c_Info) :: info_c + integer(c_Comm) :: comm_c + type(c_ptr) :: baseptr_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_allocate_shared_c(size, disp_unit, info%MPI_VAL, comm%MPI_VAL, baseptr, win%MPI_VAL) + else + disp_unit_c = disp_unit + info_c = info%MPI_VAL + comm_c = comm%MPI_VAL + ierror_c = MPIR_Win_allocate_shared_c(size, disp_unit_c, info_c, comm_c, baseptr_c, win_c) + baseptr = baseptr_c + win%MPI_VAL = win_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_allocate_shared_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_attach_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_attach_f08ts.F90 new file mode 100644 index 0000000..cab6499 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_attach_f08ts.F90 @@ -0,0 +1,33 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_attach_f08ts(win, base, size, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_attach_cdesc + + implicit none + + type(MPI_Win), intent(in) :: win + type(*), dimension(..), asynchronous :: base + integer(kind=MPI_ADDRESS_KIND), intent(in) :: size + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(kind=MPI_ADDRESS_KIND) :: size_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_attach_cdesc(win%MPI_VAL, base, size) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_attach_cdesc(win_c, base, size) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_attach_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_create_dynamic_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_create_dynamic_f08ts.F90 new file mode 100644 index 0000000..34ebfcf --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_create_dynamic_f08ts.F90 @@ -0,0 +1,35 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_create_dynamic_f08(info, comm, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Info, MPI_Comm, MPI_Win + use :: mpi_c_interface, only : c_Info, c_Comm, c_Win + use :: mpi_c_interface, only : MPIR_Win_create_dynamic_c + + implicit none + + type(MPI_Info), intent(in) :: info + type(MPI_Comm), intent(in) :: comm + type(MPI_Win), intent(out) :: win + integer, optional, intent(out) :: ierror + + integer(c_Info) :: info_c + integer(c_Comm) :: comm_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_create_dynamic_c(info%MPI_VAL, comm%MPI_VAL, win%MPI_VAL) + else + info_c = info%MPI_VAL + comm_c = comm%MPI_VAL + ierror_c = MPIR_Win_create_dynamic_c(info_c, comm_c, win_c) + win%MPI_VAL = win_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_create_dynamic_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_detach_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_detach_f08ts.F90 new file mode 100644 index 0000000..f3d0bd0 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_detach_f08ts.F90 @@ -0,0 +1,30 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_detach_f08ts(win, base, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_detach_cdesc + + implicit none + + type(MPI_Win), intent(in) :: win + type(*), dimension(..), asynchronous :: base + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_detach_cdesc(win%MPI_VAL, base) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_detach_cdesc(win_c, base) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_detach_f08ts diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_all_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_all_f08ts.F90 new file mode 100644 index 0000000..ad076a0 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_all_f08ts.F90 @@ -0,0 +1,29 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_flush_all_f08(win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_flush_all_c + + implicit none + + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_flush_all_c(win%MPI_VAL) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_flush_all_c(win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_flush_all_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_f08ts.F90 new file mode 100644 index 0000000..3289677 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_f08ts.F90 @@ -0,0 +1,31 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_flush_f08(rank, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_flush_c + + implicit none + + integer, intent(in) :: rank + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: rank_c, ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_flush_c(rank, win%MPI_VAL) + else + rank_c = rank + win_c = win%MPI_VAL + ierror_c = MPIR_Win_flush_c(rank_c, win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_flush_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_all_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_all_f08ts.F90 new file mode 100644 index 0000000..a2764ef --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_all_f08ts.F90 @@ -0,0 +1,29 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_flush_local_all_f08(win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_flush_local_all_c + + implicit none + + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_flush_local_all_c(win%MPI_VAL) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_flush_local_all_c(win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_flush_local_all_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_f08ts.F90 new file mode 100644 index 0000000..cfc9e25 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_f08ts.F90 @@ -0,0 +1,31 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_flush_local_f08(rank, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_flush_local_c + + implicit none + + integer, intent(in) :: rank + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: rank_c, ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_flush_local_c(rank, win%MPI_VAL) + else + rank_c = rank + win_c = win%MPI_VAL + ierror_c = MPIR_Win_flush_local_c(rank_c, win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_flush_local_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_get_info_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_get_info_f08ts.F90 new file mode 100644 index 0000000..3f1d61c --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_get_info_f08ts.F90 @@ -0,0 +1,32 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_get_info_f08(win, info_used, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win, MPI_Info + use :: mpi_c_interface_types, only : c_Win, c_Info + use :: mpi_c_interface, only : MPIR_Win_get_info_c + + implicit none + + type(MPI_Win), intent(in) :: win + type(MPI_Info), intent(out) :: info_used + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_Info) :: info_used_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_get_info_c(win%MPI_VAL, info_used%MPI_VAL) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_get_info_c(win_c, info_used_c) + info_used%MPI_VAL = info_used_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_get_info_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_lock_all_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_lock_all_f08ts.F90 new file mode 100644 index 0000000..b349654 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_lock_all_f08ts.F90 @@ -0,0 +1,32 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_lock_all_f08(assert, win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_lock_all_c + + implicit none + + integer, intent(in) :: assert + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_int) :: assert_c + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_lock_all_c(assert, win%MPI_VAL) + else + assert_c = assert + win_c = win%MPI_VAL + ierror_c = MPIR_Win_lock_all_c(assert_c, win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_lock_all_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_set_info_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_set_info_f08ts.F90 new file mode 100644 index 0000000..73505fd --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_set_info_f08ts.F90 @@ -0,0 +1,32 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_set_info_f08(win, info, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win, MPI_info + use :: mpi_c_interface_types, only : c_Win, c_Info + use :: mpi_c_interface, only : MPIR_Win_set_info_c + + implicit none + + type(MPI_Win), intent(in) :: win + type(MPI_Info), intent(in) :: info + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_Info) :: info_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_set_info_c(win%MPI_VAL, info%MPI_VAL) + else + win_c = win%MPI_VAL + info_c = info%MPI_VAL + ierror_c = MPIR_Win_set_info_c(win_c, info_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_set_info_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_shared_query_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_shared_query_f08ts.F90 new file mode 100644 index 0000000..966364c --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_shared_query_f08ts.F90 @@ -0,0 +1,36 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_shared_query_f08(win, rank, size, disp_unit, baseptr, ierror) + use, intrinsic :: iso_c_binding, only : c_int, c_ptr + use :: mpi_f08, only : MPI_Win + use :: mpi_f08_compile_constants, only : MPI_ADDRESS_KIND + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_shared_query_c + + implicit none + + type(MPI_Win), intent(in) :: win + integer, intent(in) :: rank + integer(kind=MPI_ADDRESS_KIND), intent(out) :: size + integer, intent(out) :: disp_unit + type(c_ptr), intent(out) :: baseptr + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: rank_c, disp_unit_c, ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_shared_query_c(win%MPI_VAL, rank, size, disp_unit, baseptr) + else + win_c = win%MPI_VAL + rank_c = rank + ierror_c = MPIR_Win_shared_query_c(win_c, rank_c, size, disp_unit_c, baseptr) + disp_unit = disp_unit_c + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_shared_query_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_sync_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_sync_f08ts.F90 new file mode 100644 index 0000000..6703130 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_sync_f08ts.F90 @@ -0,0 +1,29 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_sync_f08(win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_sync_c + + implicit none + + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_sync_c(win%MPI_VAL) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_sync_c(win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_sync_f08 diff --git a/src/binding/fortran/use_mpi_f08/wrappers_f/win_unlock_all_f08ts.F90 b/src/binding/fortran/use_mpi_f08/wrappers_f/win_unlock_all_f08ts.F90 new file mode 100644 index 0000000..b12cfb9 --- /dev/null +++ b/src/binding/fortran/use_mpi_f08/wrappers_f/win_unlock_all_f08ts.F90 @@ -0,0 +1,29 @@ +! -*- Mode: Fortran; -*- +! +! (C) 2014 by Argonne National Laboratory. +! See COPYRIGHT in top-level directory. +! +subroutine MPI_Win_unlock_all_f08(win, ierror) + use, intrinsic :: iso_c_binding, only : c_int + use :: mpi_f08, only : MPI_Win + use :: mpi_c_interface_types, only : c_Win + use :: mpi_c_interface, only : MPIR_Win_unlock_all_c + + implicit none + + type(MPI_Win), intent(in) :: win + integer, optional, intent(out) :: ierror + + integer(c_Win) :: win_c + integer(c_int) :: ierror_c + + if (c_int == kind(0)) then + ierror_c = MPIR_Win_unlock_all_c(win%MPI_VAL) + else + win_c = win%MPI_VAL + ierror_c = MPIR_Win_unlock_all_c(win_c) + end if + + if (present(ierror)) ierror = ierror_c + +end subroutine MPI_Win_unlock_all_f08 ----------------------------------------------------------------------- Summary of changes: confdb/aclocal_fc.m4 | 12 +- .../fortran/use_mpi_f08/mpi_c_interface_cdesc.F90 | 144 +++++++++- .../fortran/use_mpi_f08/mpi_c_interface_nobuf.F90 | 163 ++++++++++- src/binding/fortran/use_mpi_f08/mpi_f08.F90 | 309 +++++++++++++++++++- .../use_mpi_f08/wrappers_f/comm_get_info_f08ts.F90 | 32 ++ .../use_mpi_f08/wrappers_f/comm_set_info_f08ts.F90 | 32 ++ .../wrappers_f/compare_and_swap_f08ts.F90 | 43 +++ .../use_mpi_f08/wrappers_f/fetch_and_op_f08ts.F90 | 45 +++ .../wrappers_f/get_accumulate_f08ts.F90 | 63 ++++ .../use_mpi_f08/wrappers_f/raccumulate_f08ts.F90 | 56 ++++ .../wrappers_f/rget_accumulate_f08ts.F90 | 66 +++++ .../fortran/use_mpi_f08/wrappers_f/rget_f08ts.F90 | 53 ++++ .../fortran/use_mpi_f08/wrappers_f/rput_f08ts.F90 | 53 ++++ .../use_mpi_f08/wrappers_f/win_allocate_f08ts.F90 | 43 +++ .../wrappers_f/win_allocate_shared_f08ts.F90 | 43 +++ .../use_mpi_f08/wrappers_f/win_attach_f08ts.F90 | 33 ++ .../wrappers_f/win_create_dynamic_f08ts.F90 | 35 +++ .../use_mpi_f08/wrappers_f/win_detach_f08ts.F90 | 30 ++ .../use_mpi_f08/wrappers_f/win_flush_all_f08ts.F90 | 29 ++ .../use_mpi_f08/wrappers_f/win_flush_f08ts.F90 | 31 ++ .../wrappers_f/win_flush_local_all_f08ts.F90 | 29 ++ .../wrappers_f/win_flush_local_f08ts.F90 | 31 ++ .../use_mpi_f08/wrappers_f/win_get_info_f08ts.F90 | 32 ++ .../use_mpi_f08/wrappers_f/win_lock_all_f08ts.F90 | 32 ++ .../use_mpi_f08/wrappers_f/win_set_info_f08ts.F90 | 32 ++ .../wrappers_f/win_shared_query_f08ts.F90 | 36 +++ .../use_mpi_f08/wrappers_f/win_sync_f08ts.F90 | 29 ++ .../wrappers_f/win_unlock_all_f08ts.F90 | 29 ++ 28 files changed, 1555 insertions(+), 10 deletions(-) create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/comm_get_info_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/comm_set_info_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/compare_and_swap_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/fetch_and_op_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/get_accumulate_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/raccumulate_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/rget_accumulate_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/rget_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/rput_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_allocate_shared_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_attach_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_create_dynamic_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_detach_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_all_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_all_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_flush_local_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_get_info_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_lock_all_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_set_info_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_shared_query_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_sync_f08ts.F90 create mode 100644 src/binding/fortran/use_mpi_f08/wrappers_f/win_unlock_all_f08ts.F90 hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-99-gc3ab4ae
by noreply＠mpich.org 20 Aug '14

20 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via c3ab4aee1256f18b7e7e791ba758c08431acc71c (commit) from e9d8bfc07a24e4ebd8b65f578317cae60af0e20c (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/c3ab4aee1256f18b7e7e791ba758c0843… commit c3ab4aee1256f18b7e7e791ba758c08431acc71c Author: Norio Yamaguchi <norio.yamaguchi(a)riken.jp> Date: Wed Aug 20 10:05:32 2014 +0900 Fix memory leak in netmod-IB Some memories allocated in an initialization process are not released if all processes use shared memory for communication. Signed-off-by: Pavan Balaji <balaji(a)anl.gov> diff --git a/src/mpid/ch3/channels/nemesis/netmod/ib/ib_init.c b/src/mpid/ch3/channels/nemesis/netmod/ib/ib_init.c index fba362b..4f8b5bc 100644 --- a/src/mpid/ch3/channels/nemesis/netmod/ib/ib_init.c +++ b/src/mpid/ch3/channels/nemesis/netmod/ib/ib_init.c @@ -606,12 +606,19 @@ int MPID_nem_ib_init(MPIDI_PG_t * pg_p, int pg_rank, char **bc_val_p, int *val_m /* We need to communicate with all other ranks in close sequence. */ MPID_nem_ib_conns_ref_count = MPID_nem_ib_nranks - MPID_nem_mem_region.num_local; + if (MPID_nem_ib_conns_ref_count == 0) { + MPIU_Free(MPID_nem_ib_conns); + } + for (i = 0; i < MPID_nem_mem_region.num_local; i++) { if (MPID_nem_mem_region.local_procs[i] != MPID_nem_ib_myrank) { ibcom_errno = MPID_nem_ib_com_close(MPID_nem_ib_scratch_pad_fds [MPID_nem_mem_region.local_procs[i]]); - MPID_nem_ib_scratch_pad_fds_ref_count--; + if (--MPID_nem_ib_scratch_pad_fds_ref_count == 0) { + MPIU_Free(MPID_nem_ib_scratch_pad_fds); + MPIU_Free(MPID_nem_ib_scratch_pad_ibcoms); + } } } #endif ----------------------------------------------------------------------- Summary of changes: src/mpid/ch3/channels/nemesis/netmod/ib/ib_init.c | 9 ++++++++- 1 files changed, 8 insertions(+), 1 deletions(-) hooks/post-receive -- MPICH primary repository

1 0

[mpich] MPICH primary repository branch, master, updated. v3.1.2-98-ge9d8bfc
by noreply＠mpich.org 19 Aug '14

19 Aug '14

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "MPICH primary repository". The branch, master has been updated via e9d8bfc07a24e4ebd8b65f578317cae60af0e20c (commit) from 29323e596753dbb455d8c242dd47a5bd8daefde9 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- http://git.mpich.org/mpich.git/commitdiff/e9d8bfc07a24e4ebd8b65f578317cae60… commit e9d8bfc07a24e4ebd8b65f578317cae60af0e20c Author: Junchao Zhang <jczhang(a)mcs.anl.gov> Date: Mon Aug 18 15:53:33 2014 -0500 Fix MPI_Aint casting bugs in F77/90 bindings Also added a patch from Bill Gropp to warn about unhandled MPI_Aint. Fixes #2162 Signed-off-by: William Gropp <wgropp(a)illinois.edu> diff --git a/src/binding/fortran/mpif_h/buildiface b/src/binding/fortran/mpif_h/buildiface index 0221eb6..c9c0577 100755 --- a/src/binding/fortran/mpif_h/buildiface +++ b/src/binding/fortran/mpif_h/buildiface @@ -235,6 +235,16 @@ foreach $_ (@ARGV) { 'get-5' => 'MPI_Aint *', 'alloc_mem-1' => 'MPI_Aint *', 'win_shared_query-3' => 'MPI_Aint *', + 'compare_and_swap-6' => 'MPI_Aint *', + 'fetch_and_op-5' => 'MPI_Aint *', + 'get_accumulate-8' => 'MPI_Aint *', + 'rput-5' => 'MPI_Aint *', + 'rget-5' => 'MPI_Aint *', + 'raccumulate-5' => 'MPI_Aint *', + 'rget_accumulate-8' => 'MPI_Aint *', + 'win_attach-3' => 'MPI_Aint *', + 'win_allocate-1' => 'MPI_Aint *', + 'win_allocate_shared-1' => 'MPI_Aint *', #'status_set_elements_x-3' => 'MPI_Count *', ); @@ -744,6 +754,16 @@ foreach $_ (@ARGV) { 'Put' => '5', 'Put-5' => 'in:aintToVal', 'Get' => '5', 'Get-5' => 'in:aintToVal', 'Alloc_mem' => '1', 'Alloc_mem-1' => 'in:aintToVal', + 'Compare_and_swap' => '6', 'Compare_and_swap-6' => 'in:aintToVal', + 'Fetch_and_op' => '5', 'Fetch_and_op-5' => 'in:aintToVal', + 'Get_accumulate' => '8', 'Get_accumulate-8' => 'in:aintToVal', + 'Rput' => '5', 'Rput-5' => 'in:aintToVal', + 'Rget' => '5', 'Rget-5' => 'in:aintToVal', + 'Raccumulate' => '5', 'Raccumulate-5' => 'in:aintToVal', + 'Rget_accumulate' => '8', 'Rget_accumulate-8' => 'in:aintToVal', + 'Win_attach' => '3', 'Win_attach-3' => 'in:aintToVal', + 'Win_allocate' => '1', 'Win_allocate-1' => 'in:aintToVal', + 'Win_allocate_shared' => '1', 'Win_allocate_shared-1' => 'in:aintToVal', 'Win_get_name' => '2', 'Win_get_name-2' => 'out:blankpad', 'Win_set_name' => '2', 'Win_set_name-2' => 'in:addnull', 'Win_test' => '2', 'Win_test-2' => 'out:logical', @@ -1661,6 +1681,10 @@ sub print_call_args { print $OUTFD "MPI_File_f2c(*v$count)"; } else { + if ($parm =~ /^MPI_Aint$/) { + print STDERR "Warning: Found a cast to MPI_Aint in $routine_name\n"; + print STDERR "This usually means that a conversion from MPI_Aint* to an MPI_Aint value is missing\n"; + } if ($arg_addresses[$count] > 0) { print "Adding ($parm) for $parm\n" if $debug; print $OUTFD "($parm)"; ----------------------------------------------------------------------- Summary of changes: src/binding/fortran/mpif_h/buildiface | 24 ++++++++++++++++++++++++ 1 files changed, 24 insertions(+), 0 deletions(-) hooks/post-receive -- MPICH primary repository

1 0