12.3.4. Sessions Model Examples

This section presents several examples of how to use MPI Sessions to create MPI Groups and MPI Communicators.

Example Example illustrating creation of an MPI communicator using the Sessions Model.

#include <stdio.h> 
#include <stdlib.h> 
#include <string.h> 
#include "mpi.h" 
 
static MPI_Session lib_shandle = MPI_SESSION_NULL; 
static MPI_Comm lib_comm = MPI_COMM_NULL; 
 
int library_foo_init(void) 
{ 
   int rc, flag, valuelen; 
   int ret = 0; 
   const char pset_name[] = "mpi://WORLD"; 
   const char mt_key[] = "thread_level"; 
   const char mt_value[] = "MPI_THREAD_MULTIPLE"; 
   char out_value[100];   /* large enough */ 
   MPI_Group wgroup = MPI_GROUP_NULL; 
   MPI_Info sinfo = MPI_INFO_NULL; 
   MPI_Info tinfo = MPI_INFO_NULL; 
 
   MPI_Info_create(&sinfo); 
   MPI_Info_set(sinfo, mt_key, mt_value); 
   rc = MPI_Session_init(sinfo, MPI_ERRORS_RETURN, 
                         &lib_shandle); 
   if (rc != MPI_SUCCESS) { 
      ret = -1; 
      goto fn_exit; 
   } 
 
   /* 
    * check we got thread support level foo library needs 
    */ 
   rc = MPI_Session_get_info(lib_shandle, &tinfo); 
   if (rc != MPI_SUCCESS) { 
      ret = -1; 
      goto fn_exit; 
   } 
 
   valuelen = sizeof(out_value); 
   MPI_Info_get_string(tinfo, mt_key, &valuelen, 
                       out_value, &flag); 
   if (0 == flag) { 
      printf("Could not find key %s\n", mt_key); 
      ret = -1; 
      goto fn_exit; 
   } 
 
   if (strcmp(out_value, mt_value)) { 
      printf("Did not get thread multiple support, got %s\n", 
             out_value); 
      ret = -1; 
      goto fn_exit; 
   } 
 
   /* 
    * create a group from the WORLD process set 
    */ 
   rc = MPI_Group_from_session_pset(lib_shandle, 
                                    pset_name, 
                                    &wgroup); 
   if (rc != MPI_SUCCESS) { 
      ret = -1; 
      goto fn_exit; 
   } 
 
   /* 
    * get a communicator 
    */ 
   rc = MPI_Comm_create_from_group(wgroup, 
                              "org.mpi-forum.mpi-v4_0.example-ex11_10", 
                              MPI_INFO_NULL, 
                              MPI_ERRORS_RETURN, 
                              &lib_comm); 
   if (rc != MPI_SUCCESS) { 
      ret = -1; 
      goto fn_exit; 
   } 
 
   /* 
    * release unused resources 
    */ 
 
fn_exit: 
   if (wgroup != MPI_GROUP_NULL) { 
      MPI_Group_free(&wgroup); 
   } 
 
   if (sinfo != MPI_INFO_NULL) { 
      MPI_Info_free(&sinfo); 
   } 
 
   if (tinfo != MPI_INFO_NULL) { 
      MPI_Info_free(&tinfo); 
   } 
 
   if (ret != 0) { 
      MPI_Session_finalize(&lib_shandle); 
   } 
 
   return ret; 
} 

Example Sessions Model Examples shows how the predefined "mpi://WORLD" process set can be used to first create a local MPI group and then subsequently to create an MPI communicator from this group.

Example This example illustrates the use of Process Set query functions to select a Process Set to use for MPI Group creation.

#include <stdio.h> 
#include <stdlib.h> 
#include <string.h> 
#include "mpi.h" 
 
int main(int argc, char *argv[]) 
{ 
   int i, n_psets, psetlen, rc, ret; 
   int valuelen; 
   int flag = 0; 
   char *pset_name = NULL; 
   char *info_val = NULL; 
   MPI_Session shandle = MPI_SESSION_NULL; 
   MPI_Info sinfo = MPI_INFO_NULL; 
   MPI_Group pgroup = MPI_GROUP_NULL; 
 
   if (argc < 2) { 
      fprintf(stderr, "A process set name fragment is required\n"); 
      return EXIT_FAILURE; 
   } 
 
   rc = MPI_Session_init(MPI_INFO_NULL, MPI_ERRORS_RETURN, &shandle); 
   if (rc != MPI_SUCCESS) { 
      fprintf(stderr, "Could not initialize session, bailing out\n"); 
      return EXIT_FAILURE; 
   } 
 
   MPI_Session_get_num_psets(shandle, MPI_INFO_NULL, &n_psets); 
 
   for (i=0, pset_name=NULL; i<n_psets; i++) { 
       psetlen = 0; 
       MPI_Session_get_nth_pset(shandle, MPI_INFO_NULL, i, 
                                &psetlen, NULL); 
       pset_name = (char *)malloc(sizeof(char) * psetlen); 
       MPI_Session_get_nth_pset(shandle, MPI_INFO_NULL, i, 
                                &psetlen, pset_name); 
       if (strstr(pset_name, argv[1]) != NULL) break; 
 
       free(pset_name); 
       pset_name = NULL; 
   } 
 
   if (pset_name == NULL) { 
       fprintf(stderr, "Unable to find matching process set\n"); 
       return EXIT_FAILURE; 
   } 
 
   /* 
    * get instance of an info object for this Session 
    */ 
 
   MPI_Session_get_pset_info(shandle, pset_name, &sinfo); 
   valuelen = 0; 
   MPI_Info_get_string(sinfo, "mpi_size", &valuelen, NULL, &flag); 
   if (flag) { 
       info_val = (char *)malloc(valuelen); 
       MPI_Info_get_string(sinfo, "mpi_size", &valuelen, info_val, &flag); 
       free(info_val); 
    } 
 
   /* 
    * create a group from the process set 
    */ 
 
   rc = MPI_Group_from_session_pset(shandle, pset_name, 
                                    &pgroup); 
   ret = (rc == MPI_SUCCESS) ? 0 : EXIT_FAILURE; 
 
   free(pset_name); 
   if (pgroup != MPI_GROUP_NULL) { 
       MPI_Group_free(&pgroup); 
   } 
   MPI_Info_free(&sinfo); 
   MPI_Session_finalize(&shandle); 
 
   fprintf(stderr, "Test completed ret = %d\n", ret); 
   return ret; 
} 

Example Sessions Model Examples illustrates several aspects of the Sessions Model. First, the default error handler can be specified when instantiating a Session instance. Second, there must be at least two process sets associated with a Session. Third, the example illustrates use of the Sessions info object and the one required key: mpi_size.

Example A Fortran 2008 example illustrating how to obtain information about available process sets, create an MPI Group from a process set, and subsequently create an MPI Communicator.

PROGRAM MAIN 
    USE mpi_f08 
    IMPLICIT NONE 
    INTEGER :: pset_len, ierror, n_psets 
    CHARACTER(LEN=:), ALLOCATABLE :: pset_name 
    TYPE(MPI_Session) :: shandle 
    TYPE(MPI_Group) :: pgroup 
    TYPE(MPI_Comm) :: pcomm 
 
    CALL MPI_Session_init(MPI_INFO_NULL, MPI_ERRORS_RETURN, & 
                         shandle, ierror) 
    IF (ierror .NE. MPI_SUCCESS) THEN 
       WRITE(*,*) "MPI_Session_init failed" 
       ERROR STOP 
    END IF 
 
    CALL MPI_Session_get_num_psets(shandle, MPI_INFO_NULL, n_psets) 
    IF (n_psets .LT. 2)  THEN 
       WRITE(*,*) "MPI_Session_get_num_psets didn't return at least 2 psets" 
       ERROR STOP 
    END IF 
 
! 
!   Just get the second pset's length and name 
!   Note that index values are zero-based, even in Fortran 
! 
 
    pset_len = 0 
    CALL MPI_Session_get_nth_pset(shandle, MPI_INFO_NULL, 1,     & 
                                  pset_len, pset_name) 
    ALLOCATE(CHARACTER(LEN=pset_len)::pset_name) 
    CALL MPI_Session_get_nth_pset(shandle, MPI_INFO_NULL, 1,     & 
                                  pset_len, pset_name) 
 
! 
!   create a group from the pset 
! 
    CALL MPI_Group_from_session_pset(shandle, pset_name, pgroup) 
! 
!   free the buffer used for the pset name 
! 
    DEALLOCATE(pset_name) 
 
! 
!   create a MPI communicator from the group 
! 
    CALL MPI_Comm_create_from_group(pgroup, "session_example",    & 
                                    MPI_INFO_NULL,                & 
                                    MPI_ERRORS_RETURN,            & 
                                    pcomm) 
 
    CALL MPI_Barrier(pcomm, ierror) 
    IF (ierror .NE. MPI_SUCCESS) THEN 
        WRITE(*,*) "Barrier call on communicator failed" 
        ERROR STOP 
    END IF 
 
    CALL MPI_Comm_free(pcomm) 
    CALL MPI_Group_free(pgroup) 
    CALL MPI_Session_finalize(shandle, ierror) 
 
END PROGRAM MAIN 

Note in this example that the call to MPI_SESSION_FINALIZE may block in order to ensure that the calling MPI process has completed its involvement in the preceding MPI_BARRIER operation. If MPI_COMM_DISCONNECT had been used instead of MPI_COMM_FREE, the example would have blocked in MPI_COMM_DISCONNECT rather than MPI_SESSION_FINALIZE.