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-2008 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 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 #include "ompi_config.h" 22 #include <stdio.h> 23 24 #include "ompi/mpi/c/bindings.h" 25 #include "ompi/runtime/params.h" 26 #include "ompi/communicator/communicator.h" 27 #include "ompi/errhandler/errhandler.h" 28 #include "ompi/mpi/fortran/base/fint_2_int.h" 29 #include "ompi/memchecker.h" 30 31 #if OMPI_BUILD_MPI_PROFILING 32 #if OPAL_HAVE_WEAK_SYMBOLS 33 #pragma weak MPI_Comm_c2f = PMPI_Comm_c2f 34 #endif 35 #define MPI_Comm_c2f PMPI_Comm_c2f 36 #endif 37 38 static const char FUNC_NAME[] = "MPI_Comm_c2f"; 39 40 41 MPI_Fint MPI_Comm_c2f(MPI_Comm comm) 42 { 43 MEMCHECKER( 44 memchecker_comm(comm); 45 ); 46 47 OPAL_CR_NOOP_PROGRESS(); 48 49 if ( MPI_PARAM_CHECK) { 50 OMPI_ERR_INIT_FINALIZE(FUNC_NAME); 51 52 /* Note that ompi_comm_invalid() explicitly checks for 53 MPI_COMM_NULL, but MPI_COMM_C2F is supposed to treat 54 MPI_COMM_NULL as a valid communicator (and therefore return 55 a valid Fortran handle for it). Hence, this function 56 should not return an error if MPI_COMM_NULL is passed in. 57 58 See a big comment in ompi/communicator/communicator.h about 59 this. */ 60 if (ompi_comm_invalid (comm) && MPI_COMM_NULL != comm) { 61 return OMPI_INT_2_FINT(-1); 62 } 63 } 64 65 return OMPI_INT_2_FINT(comm->c_f_to_c_index); 66 }