root/ompi/mpi/fortran/mpif-h/info_set_f.c

DEFINITIONS

1. ompi_info_set_f

   1 /*
   2  * Copyright (c) 2004-2007 The Trustees of Indiana University and Indiana
   3  *                         University Research and Technology
   4  *                         Corporation.  All rights reserved.
   5  * Copyright (c) 2004-2005 The University of Tennessee and The University
   6  *                         of Tennessee Research Foundation.  All rights
   7  *                         reserved.
   8  * Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
   9  *                         University of Stuttgart.  All rights reserved.
  10  * Copyright (c) 2004-2005 The Regents of the University of California.
  11  *                         All rights reserved.
  12  * Copyright (c) 2006-2012 Cisco Systems, Inc.  All rights reserved.
  13  * Copyright (c) 2015-2017 Research Organization for Information Science
  14  *                         and Technology (RIST). All rights reserved.
  15  * $COPYRIGHT$
  16  *
  17  * Additional copyrights may follow
  18  *
  19  * $HEADER$
  20  */
  21 
  22 #include "ompi_config.h"
  23 
  24 #include "ompi/mpi/fortran/mpif-h/bindings.h"
  25 #include "ompi/constants.h"
  26 #include "ompi/communicator/communicator.h"
  27 #include "ompi/mpi/fortran/base/fortran_base_strings.h"
  28 
  29 #if OMPI_BUILD_MPI_PROFILING
  30 #if OPAL_HAVE_WEAK_SYMBOLS
  31 #pragma weak PMPI_INFO_SET = ompi_info_set_f
  32 #pragma weak pmpi_info_set = ompi_info_set_f
  33 #pragma weak pmpi_info_set_ = ompi_info_set_f
  34 #pragma weak pmpi_info_set__ = ompi_info_set_f
  35 
  36 #pragma weak PMPI_Info_set_f = ompi_info_set_f
  37 #pragma weak PMPI_Info_set_f08 = ompi_info_set_f
  38 #else
  39 OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_SET,
  40                             pmpi_info_set,
  41                             pmpi_info_set_,
  42                             pmpi_info_set__,
  43                             pompi_info_set_f,
  44                             (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len),
  45                             (info, key, value, ierr, key_len, value_len) )
  46 #endif
  47 #endif
  48 
  49 #if OPAL_HAVE_WEAK_SYMBOLS
  50 #pragma weak MPI_INFO_SET = ompi_info_set_f
  51 #pragma weak mpi_info_set = ompi_info_set_f
  52 #pragma weak mpi_info_set_ = ompi_info_set_f
  53 #pragma weak mpi_info_set__ = ompi_info_set_f
  54 
  55 #pragma weak MPI_Info_set_f = ompi_info_set_f
  56 #pragma weak MPI_Info_set_f08 = ompi_info_set_f
  57 #else
  58 #if ! OMPI_BUILD_MPI_PROFILING
  59 OMPI_GENERATE_F77_BINDINGS (MPI_INFO_SET,
  60                             mpi_info_set,
  61                             mpi_info_set_,
  62                             mpi_info_set__,
  63                             ompi_info_set_f,
  64                             (MPI_Fint *info, char *key, char *value, MPI_Fint *ierr, int key_len, int value_len),
  65                             (info, key, value, ierr, key_len, value_len) )
  66 #else
  67 #define ompi_info_set_f pompi_info_set_f
  68 #endif
  69 #endif
  70 
  71 
  72 static const char FUNC_NAME[] = "MPI_INFO_SET";
  73 
  74 /* Note that the key_len and value_len parameters are silently added
  75    by the Fortran compiler, and will be filled in with the actual
  76    length of the character array from the caller.  Hence, it's the max
  77    length of the string that we can use. */
  78 
  79 void ompi_info_set_f(MPI_Fint *info, char *key, char *value, MPI_Fint *ierr,
  80                     int key_len, int value_len)
  81 {
  82     int ret, c_ierr;
  83     MPI_Info c_info;
  84     char *c_key = NULL, *c_value = NULL;
  85 
  86     if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key)) ||
  87         OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(value, value_len,
  88                                                        &c_value))) {
  89         c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
  90         if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
  91         if (NULL != c_key) {
  92             free(c_key);
  93         }
  94         return;
  95     }
  96     c_info = PMPI_Info_f2c(*info);
  97 
  98     c_ierr = PMPI_Info_set(c_info, c_key, c_value);
  99     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 100 
 101     free(c_key);
 102     free(c_value);
 103 }