ompi/mpi/fortran/mpif-h/comm_spawn_multiple

/* [<][>][^][v][top][bottom][index][help] */
This source file includes following definitions.
ompi_comm_spawn_multiple_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 (c) 2016      Los Alamos National Security, LLC. All rights
  16  *                         reserved.
  17  * $COPYRIGHT$
  18  *
  19  * Additional copyrights may follow
  20  *
  21  * $HEADER$
  22  */
  23 
  24 #include "ompi_config.h"
  25 
  26 #include "ompi/mpi/fortran/mpif-h/bindings.h"
  27 #include "ompi/mpi/fortran/base/constants.h"
  28 #include "ompi/mpi/fortran/base/fortran_base_strings.h"
  29 #include "opal/util/argv.h"
  30 
  31 
  32 #if OMPI_BUILD_MPI_PROFILING
  33 #if OPAL_HAVE_WEAK_SYMBOLS
  34 #pragma weak PMPI_COMM_SPAWN_MULTIPLE = ompi_comm_spawn_multiple_f
  35 #pragma weak pmpi_comm_spawn_multiple = ompi_comm_spawn_multiple_f
  36 #pragma weak pmpi_comm_spawn_multiple_ = ompi_comm_spawn_multiple_f
  37 #pragma weak pmpi_comm_spawn_multiple__ = ompi_comm_spawn_multiple_f
  38 
  39 #pragma weak PMPI_Comm_spawn_multiple_f = ompi_comm_spawn_multiple_f
  40 #pragma weak PMPI_Comm_spawn_multiple_f08 = ompi_comm_spawn_multiple_f
  41 #else
  42 OMPI_GENERATE_F77_BINDINGS (PMPI_COMM_SPAWN_MULTIPLE,
  43                            pmpi_comm_spawn_multiple,
  44                            pmpi_comm_spawn_multiple_,
  45                            pmpi_comm_spawn_multiple__,
  46                            pompi_comm_spawn_multiple_f,
  47                            (MPI_Fint *count, char *array_of_commands, char *array_of_argv, MPI_Fint *array_of_maxprocs, MPI_Fint *array_of_info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr, int cmd_string_len, int argv_string_len),
  48                            (count, array_of_commands, array_of_argv, array_of_maxprocs, array_of_info, root, comm, intercomm, array_of_errcodes, ierr, cmd_string_len, argv_string_len) )
  49 #endif
  50 #endif
  51 
  52 #if OPAL_HAVE_WEAK_SYMBOLS
  53 #pragma weak MPI_COMM_SPAWN_MULTIPLE = ompi_comm_spawn_multiple_f
  54 #pragma weak mpi_comm_spawn_multiple = ompi_comm_spawn_multiple_f
  55 #pragma weak mpi_comm_spawn_multiple_ = ompi_comm_spawn_multiple_f
  56 #pragma weak mpi_comm_spawn_multiple__ = ompi_comm_spawn_multiple_f
  57 
  58 #pragma weak MPI_Comm_spawn_multiple_f = ompi_comm_spawn_multiple_f
  59 #pragma weak MPI_Comm_spawn_multiple_f08 = ompi_comm_spawn_multiple_f
  60 #else
  61 #if ! OMPI_BUILD_MPI_PROFILING
  62 OMPI_GENERATE_F77_BINDINGS (MPI_COMM_SPAWN_MULTIPLE,
  63                            mpi_comm_spawn_multiple,
  64                            mpi_comm_spawn_multiple_,
  65                            mpi_comm_spawn_multiple__,
  66                            ompi_comm_spawn_multiple_f,
  67                            (MPI_Fint *count, char *array_of_commands, char *array_of_argv, MPI_Fint *array_of_maxprocs, MPI_Fint *array_of_info, MPI_Fint *root, MPI_Fint *comm, MPI_Fint *intercomm, MPI_Fint *array_of_errcodes, MPI_Fint *ierr, int cmd_string_len, int argv_string_len),
  68                            (count, array_of_commands, array_of_argv, array_of_maxprocs, array_of_info, root, comm, intercomm, array_of_errcodes, ierr, cmd_string_len, argv_string_len) )
  69 #else
  70 #define ompi_comm_spawn_multiple_f pompi_comm_spawn_multiple_f
  71 #endif
  72 #endif
  73 
  74 
  75 void ompi_comm_spawn_multiple_f(MPI_Fint *count, char *array_commands,
  76                                char *array_argv,
  77                                MPI_Fint *array_maxprocs,
  78                                MPI_Fint *array_info, MPI_Fint *root,
  79                                MPI_Fint *comm, MPI_Fint *intercomm,
  80                                MPI_Fint *array_errcds, MPI_Fint *ierr,
  81                                int cmd_string_len, int argv_string_len)
  82 {
  83     MPI_Comm c_comm, c_new_comm;
  84     MPI_Info *c_info;
  85     int size, array_size, i, c_ierr;
  86     int *c_errs;
  87     char **c_array_commands;
  88     char ***c_array_argv;
  89     OMPI_ARRAY_NAME_DECL(array_maxprocs);
  90     OMPI_ARRAY_NAME_DECL(array_errcds);
  91 
  92     c_comm = PMPI_Comm_f2c(*comm);
  93 
  94     PMPI_Comm_size(c_comm, &size);
  95 
  96     array_size = OMPI_FINT_2_INT(*count);
  97 
  98     /* It's allowed to ignore the errcodes */
  99 
 100     if (OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_errcds)) {
 101         c_errs = MPI_ERRCODES_IGNORE;
 102     } else {
 103         OMPI_ARRAY_FINT_2_INT_ALLOC(array_errcds, size);
 104         c_errs = OMPI_ARRAY_NAME_CONVERT(array_errcds);
 105     }
 106 
 107     /* It's allowed to have no argv */
 108 
 109     if (OMPI_IS_FORTRAN_ARGVS_NULL(array_argv)) {
 110         c_array_argv = MPI_ARGVS_NULL;
 111     } else {
 112         ompi_fortran_multiple_argvs_f2c(OMPI_FINT_2_INT(*count), array_argv,
 113                                         argv_string_len, &c_array_argv);
 114     }
 115 
 116     OMPI_ARRAY_FINT_2_INT(array_maxprocs, array_size);
 117 
 118     ompi_fortran_argv_count_f2c(array_commands, array_size, cmd_string_len,
 119                                 cmd_string_len, &c_array_commands);
 120 
 121     c_info = (MPI_Info *) malloc (array_size * sizeof(MPI_Info));
 122     for (i = 0; i < array_size; ++i) {
 123         c_info[i] = PMPI_Info_f2c(array_info[i]);
 124     }
 125 
 126     c_ierr = PMPI_Comm_spawn_multiple(OMPI_FINT_2_INT(*count),
 127                                      c_array_commands,
 128                                      c_array_argv,
 129                                      OMPI_ARRAY_NAME_CONVERT(array_maxprocs),
 130                                      c_info,
 131                                      OMPI_FINT_2_INT(*root),
 132                                      c_comm, &c_new_comm,
 133                                      c_errs);
 134     if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
 135 
 136     if (MPI_SUCCESS == c_ierr) {
 137         *intercomm = PMPI_Comm_c2f(c_new_comm);
 138     }
 139 
 140     if (!OMPI_IS_FORTRAN_ERRCODES_IGNORE(array_errcds)) {
 141         OMPI_ARRAY_INT_2_FINT(array_errcds, size);
 142     } else {
 143         OMPI_ARRAY_FINT_2_INT_CLEANUP(array_errcds);
 144     }
 145     OMPI_ARRAY_FINT_2_INT_CLEANUP(array_maxprocs);
 146 
 147     opal_argv_free(c_array_commands);
 148 
 149     if (MPI_ARGVS_NULL != c_array_argv && NULL != c_array_argv) {
 150         for (i = 0; i < OMPI_FINT_2_INT(*count); ++i) {
 151             opal_argv_free(c_array_argv[i]);
 152         }
 153     }
 154     free(c_array_argv);
 155     free(c_info);
 156 }
/* [<][>][^][v][top][bottom][index][help] */
root/ompi/mpi/fortran/mpif-h/comm_spawn_multiple_f.c

DEFINITIONS
