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

DEFINITIONS

1. ompi_info_get_nthkey_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_NTHKEY = ompi_info_get_nthkey_f
  32 #pragma weak pmpi_info_get_nthkey = ompi_info_get_nthkey_f
  33 #pragma weak pmpi_info_get_nthkey_ = ompi_info_get_nthkey_f
  34 #pragma weak pmpi_info_get_nthkey__ = ompi_info_get_nthkey_f
  35 
  36 #pragma weak PMPI_Info_get_nthkey_f = ompi_info_get_nthkey_f
  37 #pragma weak PMPI_Info_get_nthkey_f08 = ompi_info_get_nthkey_f
  38 #else
  39 OMPI_GENERATE_F77_BINDINGS (PMPI_INFO_GET_NTHKEY,
  40                             pmpi_info_get_nthkey,
  41                             pmpi_info_get_nthkey_,
  42                             pmpi_info_get_nthkey__,
  43                             pompi_info_get_nthkey_f,
  44                             (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len),
  45                             (info, n, key, ierr, key_len) )
  46 #endif
  47 #endif
  48 
  49 #if OPAL_HAVE_WEAK_SYMBOLS
  50 #pragma weak MPI_INFO_GET_NTHKEY = ompi_info_get_nthkey_f
  51 #pragma weak mpi_info_get_nthkey = ompi_info_get_nthkey_f
  52 #pragma weak mpi_info_get_nthkey_ = ompi_info_get_nthkey_f
  53 #pragma weak mpi_info_get_nthkey__ = ompi_info_get_nthkey_f
  54 
  55 #pragma weak MPI_Info_get_nthkey_f = ompi_info_get_nthkey_f
  56 #pragma weak MPI_Info_get_nthkey_f08 = ompi_info_get_nthkey_f
  57 #else
  58 #if ! OMPI_BUILD_MPI_PROFILING
  59 OMPI_GENERATE_F77_BINDINGS (MPI_INFO_GET_NTHKEY,
  60                             mpi_info_get_nthkey,
  61                             mpi_info_get_nthkey_,
  62                             mpi_info_get_nthkey__,
  63                             ompi_info_get_nthkey_f,
  64                             (MPI_Fint *info, MPI_Fint *n, char *key, MPI_Fint *ierr, int key_len),
  65                             (info, n, key, ierr, key_len) )
  66 #else
  67 #define ompi_info_get_nthkey_f pompi_info_get_nthkey_f
  68 #endif
  69 #endif
  70 
  71 
  72 static const char FUNC_NAME[] = "MPI_INFO_GET_NTHKEY";
  73 
  74 /* Note that the key_len parameter is silently added by the Fortran
  75    compiler, and will be filled in with the actual length of the
  76    character array from the caller.  Hence, it's the max length of the
  77    string that we can use. */
  78 
  79 void ompi_info_get_nthkey_f(MPI_Fint *info, MPI_Fint *n, char *key,
  80                            MPI_Fint *ierr, int key_len)
  81 {
  82     int c_ierr, ret;
  83     MPI_Info c_info;
  84     char c_key[MPI_MAX_INFO_KEY + 1];
  85 
  86     c_info = PMPI_Info_f2c(*info);
  87 
  88     c_ierr = PMPI_Info_get_nthkey(c_info,
  89                                  OMPI_FINT_2_INT(*n),
  90                                  c_key);
  91     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
  92 
  93     if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_key, key, key_len))) {
  94         c_ierr = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
  95         if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
  96         return;
  97     }
  98 }