root/oshmem/shmem/fortran/shmem_broadcast_f.c

   1 /*
   2  * Copyright (c) 2013-2018 Mellanox Technologies, Inc.
   3  *                         All rights reserved.
   4  * Copyright (c) 2013 Cisco Systems, Inc.  All rights reserved.
   5  * $COPYRIGHT$
   6  *
   7  * Additional copyrights may follow
   8  *
   9  * $HEADER$
  10  */
  11 
  12 #include "oshmem_config.h"
  13 #include "oshmem/shmem/fortran/bindings.h"
  14 #include "oshmem/include/shmem.h"
  15 #include "oshmem/constants.h"
  16 #include "oshmem/mca/scoll/scoll.h"
  17 #include "oshmem/proc/proc.h"
  18 #include "oshmem/op/op.h"
  19 
  20 #if OSHMEM_PROFILING
  21 #include "oshmem/shmem/fortran/profile/pbindings.h"
  22 SHMEM_GENERATE_WEAK_BINDINGS(SHMEM_BROADCAST4, shmem_broadcast4)
  23 SHMEM_GENERATE_WEAK_BINDINGS(SHMEM_BROADCAST8, shmem_broadcast8)
  24 SHMEM_GENERATE_WEAK_BINDINGS(SHMEM_BROADCAST32, shmem_broadcast32)
  25 SHMEM_GENERATE_WEAK_BINDINGS(SHMEM_BROADCAST64, shmem_broadcast64)
  26 #include "oshmem/shmem/fortran/profile/defines.h"
  27 #endif
  28 
  29 SHMEM_GENERATE_FORTRAN_BINDINGS_SUB (void,
  30         SHMEM_BROADCAST4,
  31         shmem_broadcast4_,
  32         shmem_broadcast4__,
  33         shmem_broadcast4_f,
  34         (FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *nlong, MPI_Fint *PE_root, MPI_Fint *PE_start, MPI_Fint * logPE_stride, MPI_Fint *PE_size, FORTRAN_POINTER_T pSync),
  35         (target, source, nlong, PE_root, PE_start, logPE_stride, PE_size, pSync))
  36 
  37 SHMEM_GENERATE_FORTRAN_BINDINGS_SUB (void,
  38         SHMEM_BROADCAST8,
  39         shmem_broadcast8_,
  40         shmem_broadcast8__,
  41         shmem_broadcast8_f,
  42         (FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *nlong, MPI_Fint *PE_root, MPI_Fint *PE_start, MPI_Fint * logPE_stride, MPI_Fint *PE_size, FORTRAN_POINTER_T pSync),
  43         (target, source, nlong, PE_root, PE_start, logPE_stride, PE_size, pSync))
  44 
  45 SHMEM_GENERATE_FORTRAN_BINDINGS_SUB (void,
  46         SHMEM_BROADCAST32,
  47         shmem_broadcast32_,
  48         shmem_broadcast32__,
  49         shmem_broadcast32_f,
  50         (FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *nlong, MPI_Fint *PE_root, MPI_Fint *PE_start, MPI_Fint * logPE_stride, MPI_Fint *PE_size, FORTRAN_POINTER_T pSync),
  51         (target, source, nlong, PE_root, PE_start, logPE_stride, PE_size, pSync))
  52 
  53 SHMEM_GENERATE_FORTRAN_BINDINGS_SUB (void,
  54         SHMEM_BROADCAST64,
  55         shmem_broadcast64_,
  56         shmem_broadcast64__,
  57         shmem_broadcast64_f,
  58         (FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *nlong, MPI_Fint *PE_root, MPI_Fint *PE_start, MPI_Fint * logPE_stride, MPI_Fint *PE_size, FORTRAN_POINTER_T pSync),
  59         (target, source, nlong, PE_root, PE_start, logPE_stride, PE_size, pSync))
  60 
  61 #define SHMEM_BROADCAST(F_NAME, T_NAME) void F_NAME(FORTRAN_POINTER_T target, \
  62     FORTRAN_POINTER_T source, \
  63     MPI_Fint *nlong,\
  64     MPI_Fint *PE_root, \
  65     MPI_Fint *PE_start, \
  66     MPI_Fint *logPE_stride, \
  67     MPI_Fint *PE_size, \
  68     FORTRAN_POINTER_T pSync)\
  69 {\
  70     int rc;\
  71     oshmem_group_t *group;\
  72     int rel_PE_root = 0;\
  73     oshmem_op_t* op = T_NAME;\
  74 \
  75     if ((0 <= OMPI_FINT_2_INT(*PE_root)) && \
  76             (OMPI_FINT_2_INT(*PE_root) < OMPI_FINT_2_INT(*PE_size)))\
  77     {\
  78         group = oshmem_proc_group_create_nofail(OMPI_FINT_2_INT(*PE_start), \
  79                 (1 << OMPI_FINT_2_INT(*logPE_stride)), \
  80                 OMPI_FINT_2_INT(*PE_size));\
  81         if (OMPI_FINT_2_INT(*PE_root) >= group->proc_count)\
  82         {\
  83             rc = OSHMEM_ERROR;\
  84             goto out;\
  85         }\
  86         \
  87         /* Define actual PE using relative in active set */\
  88         rel_PE_root = oshmem_proc_pe(group->proc_array[OMPI_FINT_2_INT(*PE_root)]);\
  89         \
  90         /* Call collective broadcast operation */\
  91         rc = group->g_scoll.scoll_broadcast( group, \
  92                 rel_PE_root, \
  93                 FPTR_2_VOID_PTR(target), \
  94                 FPTR_2_VOID_PTR(source), \
  95                 OMPI_FINT_2_INT(*nlong) * op->dt_size, \
  96                 FPTR_2_VOID_PTR(pSync), \
  97                 true, \
  98                 SCOLL_DEFAULT_ALG );\
  99     out: \
 100         oshmem_proc_group_destroy(group);\
 101         RUNTIME_CHECK_RC(rc); \
 102   }\
 103 }
 104 
 105 SHMEM_BROADCAST(shmem_broadcast4_f, oshmem_op_prod_fint4)
 106 SHMEM_BROADCAST(shmem_broadcast8_f, oshmem_op_prod_fint8)
 107 SHMEM_BROADCAST(shmem_broadcast32_f, oshmem_op_prod_fint4)
 108 SHMEM_BROADCAST(shmem_broadcast64_f, oshmem_op_prod_fint8)