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

DEFINITIONS

1. ompi_comm_spawn_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) 2010-2018 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/mpi/fortran/base/constants.h"
  26 #include "ompi/mpi/fortran/base/fortran_base_strings.h"
  27 #include "opal/util/argv.h"
  28 
  29 #if OMPI_BUILD_MPI_PROFILING
  30 #if OPAL_HAVE_WEAK_SYMBOLS
  31 #pragma weak PMPI_COMM_SPAWN = ompi_comm_spawn_f
  32 #pragma weak pmpi_comm_spawn = ompi_comm_spawn_f
  33 #pragma weak pmpi_comm_spawn_ = ompi_comm_spawn_f
  34 #pragma weak pmpi_comm_spawn__ = ompi_comm_spawn_f
  35 
  36 #pragma weak PMPI_Comm_spawn_f = ompi_comm_spawn_f
  37 #pragma weak PMPI_Comm_spawn_f08 = ompi_comm_spawn_f
  38 #else
  39 OMPI_GENERATE_F77_BINDINGS (PMPI_COMM_SPAWN,
  40                             pmpi_comm_spawn,
  41                             pmpi_comm_spawn_,
  42                             pmpi_comm_spawn__,
  43                             pompi_comm_spawn_f,
  44                             (char *command, char *argv, MPI_Fint *maxprocs, MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr, int cmd_len, int string_len),
  45                             (command, argv, maxprocs, info, root, comm, intercomm, array_of_errcodes, ierr, cmd_len, string_len) )
  46 #endif
  47 #endif
  48 
  49 #if OPAL_HAVE_WEAK_SYMBOLS
  50 #pragma weak MPI_COMM_SPAWN = ompi_comm_spawn_f
  51 #pragma weak mpi_comm_spawn = ompi_comm_spawn_f
  52 #pragma weak mpi_comm_spawn_ = ompi_comm_spawn_f
  53 #pragma weak mpi_comm_spawn__ = ompi_comm_spawn_f
  54 
  55 #pragma weak MPI_Comm_spawn_f = ompi_comm_spawn_f
  56 #pragma weak MPI_Comm_spawn_f08 = ompi_comm_spawn_f
  57 #else
  58 #if ! OMPI_BUILD_MPI_PROFILING
  59 OMPI_GENERATE_F77_BINDINGS (MPI_COMM_SPAWN,
  60                             mpi_comm_spawn,
  61                             mpi_comm_spawn_,
  62                             mpi_comm_spawn__,
  63                             ompi_comm_spawn_f,
  64                             (char *command, char *argv, MPI_Fint *maxprocs, MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr, int cmd_len, int string_len),
  65                             (command, argv, maxprocs, info, root, comm, intercomm, array_of_errcodes, ierr, cmd_len, string_len) )
  66 #else
  67 #define ompi_comm_spawn_f pompi_comm_spawn_f
  68 #endif
  69 #endif
  70 
  71 
  72 void ompi_comm_spawn_f(char *command, char *argv, MPI_Fint *maxprocs,
  73                       MPI_Fint *info, MPI_Fint *root, MPI_Fint *comm,
  74                       MPI_Fint *intercomm, MPI_Fint *array_of_errcodes,
  75                       MPI_Fint *ierr, int cmd_len, int string_len)
  76 {
  77     MPI_Comm c_comm, c_new_comm;
  78     MPI_Info c_info;
  79     int size, c_ierr;
  80     int *c_errs;
  81     char **c_argv;
  82     char *c_command;
  83     OMPI_ARRAY_NAME_DECL(array_of_errcodes);
  84 
  85     c_comm = PMPI_Comm_f2c(*comm);
  86     c_info = PMPI_Info_f2c(*info);
  87     PMPI_Comm_size(c_comm, &size);
  88     ompi_fortran_string_f2c(command, cmd_len, &c_command);
  89 
  90     /* It's allowed to ignore the errcodes */
  91 
  92     if (OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
  93         c_errs = MPI_ERRCODES_IGNORE;
  94     } else {
  95         OMPI_ARRAY_FINT_2_INT_ALLOC(array_of_errcodes, size);
  96         c_errs = OMPI_ARRAY_NAME_CONVERT(array_of_errcodes);
  97     }
  98 
  99     /* It's allowed to have no argv */
 100 
 101     if (OMPI_IS_FORTRAN_ARGV_NULL(argv)) {
 102         c_argv = MPI_ARGV_NULL;
 103     } else {
 104         ompi_fortran_argv_blank_f2c(argv, string_len, string_len, &c_argv);
 105     }
 106 
 107     c_ierr = PMPI_Comm_spawn(c_command, c_argv,
 108                             OMPI_FINT_2_INT(*maxprocs),
 109                             c_info,
 110                             OMPI_FINT_2_INT(*root),
 111                             c_comm, &c_new_comm, c_errs);
 112     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 113 
 114     if (MPI_SUCCESS == c_ierr) {
 115         *intercomm = PMPI_Comm_c2f(c_new_comm);
 116     }
 117     free(c_command);
 118     if (MPI_ARGV_NULL != c_argv && NULL != c_argv) {
 119         opal_argv_free(c_argv);
 120     }
 121     if (!OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_of_errcodes)) {
 122         OMPI_ARRAY_INT_2_FINT(array_of_errcodes, size);
 123     } else {
 124         OMPI_ARRAY_FINT_2_INT_CLEANUP(array_of_errcodes);
 125     }
 126 }
 127