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

DEFINITIONS

1. ompi_get_processor_name_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_GET_PROCESSOR_NAME = ompi_get_processor_name_f
  32 #pragma weak pmpi_get_processor_name = ompi_get_processor_name_f
  33 #pragma weak pmpi_get_processor_name_ = ompi_get_processor_name_f
  34 #pragma weak pmpi_get_processor_name__ = ompi_get_processor_name_f
  35 
  36 #pragma weak PMPI_Get_processor_name_f = ompi_get_processor_name_f
  37 #pragma weak PMPI_Get_processor_name_f08 = ompi_get_processor_name_f
  38 #else
  39 OMPI_GENERATE_F77_BINDINGS (PMPI_GET_PROCESSOR_NAME,
  40                             pmpi_get_processor_name,
  41                             pmpi_get_processor_name_,
  42                             pmpi_get_processor_name__,
  43                             pompi_get_processor_name_f,
  44                             (char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len),
  45                             (name, resultlen, ierr, name_len) )
  46 #endif
  47 #endif
  48 
  49 #if OPAL_HAVE_WEAK_SYMBOLS
  50 #pragma weak MPI_GET_PROCESSOR_NAME = ompi_get_processor_name_f
  51 #pragma weak mpi_get_processor_name = ompi_get_processor_name_f
  52 #pragma weak mpi_get_processor_name_ = ompi_get_processor_name_f
  53 #pragma weak mpi_get_processor_name__ = ompi_get_processor_name_f
  54 
  55 #pragma weak MPI_Get_processor_name_f = ompi_get_processor_name_f
  56 #pragma weak MPI_Get_processor_name_f08 = ompi_get_processor_name_f
  57 #else
  58 #if ! OMPI_BUILD_MPI_PROFILING
  59 OMPI_GENERATE_F77_BINDINGS (MPI_GET_PROCESSOR_NAME,
  60                             mpi_get_processor_name,
  61                             mpi_get_processor_name_,
  62                             mpi_get_processor_name__,
  63                             ompi_get_processor_name_f,
  64                             (char *name, MPI_Fint *resultlen, MPI_Fint *ierr, int name_len),
  65                             (name, resultlen, ierr, name_len) )
  66 #else
  67 #define ompi_get_processor_name_f pompi_get_processor_name_f
  68 #endif
  69 #endif
  70 
  71 
  72 static const char FUNC_NAME[] = "MPI_GET_PROCESSOR_NAME";
  73 
  74 /* Note that the name_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_get_processor_name_f(char *name, MPI_Fint *resultlen, MPI_Fint *ierr,
  80                               int name_len)
  81 {
  82     int ierr_c, ret;
  83     char c_name[MPI_MAX_PROCESSOR_NAME];
  84     OMPI_SINGLE_NAME_DECL(resultlen);
  85 
  86     ierr_c = PMPI_Get_processor_name(c_name,
  87                                      OMPI_SINGLE_NAME_CONVERT(resultlen));
  88 
  89     if (MPI_SUCCESS == ierr_c) {
  90         OMPI_SINGLE_INT_2_FINT(resultlen);
  91 
  92         /* Use the full length of the Fortran string, not *resultlen.
  93            See comment in ompi/mpi/fortran/base/strings.c. */
  94         if (OMPI_SUCCESS != (ret = ompi_fortran_string_c2f(c_name, name,
  95                                                            name_len))) {
  96             ierr_c = OMPI_ERRHANDLER_INVOKE(MPI_COMM_WORLD, ret, FUNC_NAME);
  97         }
  98     }
  99 
 100     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);
 101 }