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

DEFINITIONS

1. ompi_info_get_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_GET = ompi_info_get_f
  32 #pragma weak pmpi_info_get = ompi_info_get_f
  33 #pragma weak pmpi_info_get_ = ompi_info_get_f
  34 #pragma weak pmpi_info_get__ = ompi_info_get_f
  35 
  36 #pragma weak PMPI_Info_get_f = ompi_info_get_f
  37 #pragma weak PMPI_Info_get_f08 = ompi_info_get_f
  38 #else
  39 OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET,
  40                             pmpi_info_get,
  41                             pmpi_info_get_,
  42                             pmpi_info_get__,
  43                             pompi_info_get_f,
  44                             (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, ompi_fortran_logical_t *flag, MPI_Fint *ierr, int key_len, int value_len),
  45                             (info, key, valuelen, value, flag, ierr, key_len, value_len) )
  46 #endif
  47 #endif
  48 
  49 #if OPAL_HAVE_WEAK_SYMBOLS
  50 #pragma weak MPI_INFO_GET = ompi_info_get_f
  51 #pragma weak mpi_info_get = ompi_info_get_f
  52 #pragma weak mpi_info_get_ = ompi_info_get_f
  53 #pragma weak mpi_info_get__ = ompi_info_get_f
  54 
  55 #pragma weak MPI_Info_get_f = ompi_info_get_f
  56 #pragma weak MPI_Info_get_f08 = ompi_info_get_f
  57 #else
  58 #if ! OMPI_BUILD_MPI_PROFILING
  59 OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET,
  60                             mpi_info_get,
  61                             mpi_info_get_,
  62                             mpi_info_get__,
  63                             ompi_info_get_f,
  64                             (MPI_Fint *info, char *key, MPI_Fint *valuelen, char *value, ompi_fortran_logical_t *flag, MPI_Fint *ierr, int key_len, int value_len),
  65                             (info, key, valuelen, value, flag, ierr, key_len, value_len) )
  66 #else
  67 #define ompi_info_get_f pompi_info_get_f
  68 #endif
  69 #endif
  70 
  71 
  72 static const char FUNC_NAME[] = "MPI_INFO_GET";
  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_get_f(MPI_Fint *info, char *key, MPI_Fint *valuelen,
  80                     char *value, ompi_fortran_logical_t *flag, MPI_Fint *ierr,
  81                     int key_len, int value_len)
  82 {
  83     int c_ierr, ret;
  84     MPI_Info c_info;
  85     char *c_key = NULL, c_value[MPI_MAX_INFO_VAL + 1];
  86     OMPI_LOGICAL_NAME_DECL(flag);
  87 
  88     if (OMPI_SUCCESS != (ret = ompi_fortran_string_f2c(key, key_len, &c_key))) {
  89         c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
  90         if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
  91         return;
  92     }
  93     c_info = PMPI_Info_f2c(*info);
  94 
  95     c_ierr = PMPI_Info_get(c_info, c_key,
  96                           OMPI_FINT_2_INT(*valuelen),
  97                           c_value,
  98                           OMPI_LOGICAL_SINGLE_NAME_CONVERT(flag));
  99     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 100 
 101     if (MPI_SUCCESS == c_ierr) {
 102         OMPI_SINGLE_INT_2_LOGICAL(flag);
 103 
 104         /* If we found the info key, copy the value back to the
 105            Fortran string (note: all Fortran compilers have FALSE ==
 106            0, so just check for any nonzero value, because not all
 107            Fortran compilers have TRUE == 1).  Note: use the full
 108            length of the Fortran string, not *valuelen.  See comment
 109            in ompi/mpi/fortran/base/strings.c. */
 110         if (*flag && OMPI_SUCCESS !=
 111             (ret = ompi_fortran_string_c2f(c_value, value, value_len))) {
 112             c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
 113             if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 114             free(c_key);
 115             return;
 116         }
 117     }
 118 
 119     free(c_key);
 120 }