/****************************************************************************
**  SCALASCA    http://www.scalasca.org/                                   **
*****************************************************************************
**  Copyright (c) 1998-2012                                                **
**  Forschungszentrum Juelich GmbH, Juelich Supercomputing Centre          **
**                                                                         **
**  Copyright (c) 2010-2012                                                **
**  German Research School for Simulation Sciences GmbH,                   **
**  Laboratory for Parallel Programming                                    **
**                                                                         **
**  Copyright (c) 2003-2008                                                **
**  University of Tennessee, Innovative Computing Laboratory               **
**                                                                         **
**  See the file COPYRIGHT in the package base directory for details       **
****************************************************************************/

/**
 * @file  epk_fmpiwrap_ext.c
 *
 * @brief Fortran interface wrappers for external interface functions
 */

#include <stdlib.h>
#include <string.h>
#include <mpi.h>

#include "elg_error.h"
#include "elg_fmpi_defs.h"
#include "epk_fmpiwrap.h"
#include "epk_defs_mpi.h"
#include "epk_fwrapper_def.h"

/* uppercase defines */
/** All uppercase name of MPI_Abort */
#define MPI_Abort_U MPI_ABORT
/** All uppercase name of MPI_Get_count */
#define MPI_Get_count_U MPI_GET_COUNT
/** All uppercase name of MPI_Get_elements */
#define MPI_Get_elements_U MPI_GET_ELEMENTS
/** All uppercase name of MPI_Get_processor_name */
#define MPI_Get_processor_name_U MPI_GET_PROCESSOR_NAME
/** All uppercase name of MPI_Grequest_complete */
#define MPI_Grequest_complete_U MPI_GREQUEST_COMPLETE
/** All uppercase name of MPI_Grequest_start */
#define MPI_Grequest_start_U MPI_GREQUEST_START
/** All uppercase name of MPI_Status_set_cancelled */
#define MPI_Status_set_cancelled_U MPI_STATUS_SET_CANCELLED
/** All uppercase name of MPI_Status_set_elements */
#define MPI_Status_set_elements_U MPI_STATUS_SET_ELEMENTS
/** All uppercase name of MPI_Wtick */
#define MPI_Wtick_U MPI_WTICK
/** All uppercase name of MPI_Wtime */
#define MPI_Wtime_U MPI_WTIME

/* lowercase defines */
/** All lowercase name of MPI_Abort */
#define MPI_Abort_L mpi_abort
/** All lowercase name of MPI_Get_count */
#define MPI_Get_count_L mpi_get_count
/** All lowercase name of MPI_Get_elements */
#define MPI_Get_elements_L mpi_get_elements
/** All lowercase name of MPI_Get_processor_name */
#define MPI_Get_processor_name_L mpi_get_processor_name
/** All lowercase name of MPI_Grequest_complete */
#define MPI_Grequest_complete_L mpi_grequest_complete
/** All lowercase name of MPI_Grequest_start */
#define MPI_Grequest_start_L mpi_grequest_start
/** All lowercase name of MPI_Status_set_cancelled */
#define MPI_Status_set_cancelled_L mpi_status_set_cancelled
/** All lowercase name of MPI_Status_set_elements */
#define MPI_Status_set_elements_L mpi_status_set_elements
/** All lowercase name of MPI_Wtick */
#define MPI_Wtick_L mpi_wtick
/** All lowercase name of MPI_Wtime */
#define MPI_Wtime_L mpi_wtime

/**
 * @name Fortran wrappers
 * @{
 */

#ifndef NEED_F2C_CONV

/* If MPI_Comm_f2c is defined as a simple macro (which typically does nothing)
 * as it would require a "real" function if it is really needed
 * => we can save the f2c and c2s conversions */

#if defined(HAS_MPI_ABORT)
/**
 * Measurement wrapper for MPI_Abort
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Abort)(MPI_Comm* comm,
                     int*      errorcode,
                     int*      ierr)
{
  *ierr = MPI_Abort(*comm, *errorcode);
}

#endif
#if defined(HAS_MPI_GET_COUNT) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Get_count
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Get_count)(MPI_Status*   status,
                         MPI_Datatype* datatype,
                         int*          count,
                         int*          ierr)
{
  *ierr = MPI_Get_count(status, *datatype, count);
}

#endif
#if defined(HAS_MPI_GET_ELEMENTS) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Get_elements
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Get_elements)(MPI_Status*   status,
                            MPI_Datatype* datatype,
                            int*          count,
                            int*          ierr)
{
  *ierr = MPI_Get_elements(status, *datatype, count);
}

#endif
#if defined(HAS_MPI_GET_PROCESSOR_NAME) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Get_processor_name
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Get_processor_name)(char* name,
                                  int*  resultlen,
                                  int*  ierr,
                                  int   name_len)
{
  char* c_name     = NULL;
  int   c_name_len = 0;

  c_name = (char*)malloc((name_len + 1) * sizeof (char));
  if (!c_name)
  {
    exit(EXIT_FAILURE);
  }

  *ierr = MPI_Get_processor_name(c_name, resultlen);

  c_name_len = strlen(c_name);
  strncpy(name, c_name, c_name_len);
  memset(name + c_name_len, ' ', name_len - c_name_len);
  free(c_name);
}

#endif
#if defined(HAS_MPI_GREQUEST_COMPLETE) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Grequest_complete
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Grequest_complete)(MPI_Request* request,
                                 int*         ierr)
{
  *ierr = MPI_Grequest_complete(*request);
}

#endif
#if defined(HAS_MPI_GREQUEST_START) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Grequest_start
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Grequest_start)(MPI_Grequest_query_function*  query_fn,
                              MPI_Grequest_free_function*   free_fn,
                              MPI_Grequest_cancel_function* cancel_fn,
                              void*                         extra_state,
                              MPI_Request*                  request,
                              int*                          ierr)
{
  *ierr = MPI_Grequest_start(query_fn,
                             free_fn,
                             cancel_fn,
                             extra_state,
                             request);
}

#endif
#if defined(HAS_MPI_STATUS_SET_CANCELLED) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_MISC)
/**
 * Measurement wrapper for MPI_Status_set_cancelled
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Status_set_cancelled)(MPI_Status* status,
                                    int*        flag,
                                    int*        ierr)
{
  *ierr = MPI_Status_set_cancelled(status, *flag);
}

#endif
#if defined(HAS_MPI_STATUS_SET_ELEMENTS) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Status_set_elements
 * @note Auto-generated by wrapgen from template: fstd.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Status_set_elements)(MPI_Status*   status,
                                   MPI_Datatype* datatype,
                                   int*          count,
                                   int*          ierr)
{
  *ierr = MPI_Status_set_elements(status, *datatype, *count);
}

#endif

#else /* !NEED_F2C_CONV */

#if defined(HAS_MPI_ABORT)
/**
 * Measurement wrapper for MPI_Abort
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Abort)(MPI_Fint* comm,
                     MPI_Fint* errorcode,
                     MPI_Fint* ierr)
{
  *ierr = MPI_Abort(PMPI_Comm_f2c(*comm), *errorcode);
}

#endif
#if defined(HAS_MPI_GET_COUNT) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Get_count
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Get_count)(MPI_Fint* status,
                         MPI_Fint* datatype,
                         MPI_Fint* count,
                         MPI_Fint* ierr)
{
  MPI_Status  c_status;
  MPI_Status* c_status_ptr = &c_status;

  PMPI_Status_f2c(status, c_status_ptr);

  *ierr = MPI_Get_count(c_status_ptr, PMPI_Type_f2c(*datatype), count);
}

#endif
#if defined(HAS_MPI_GET_ELEMENTS) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Get_elements
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Get_elements)(MPI_Fint* status,
                            MPI_Fint* datatype,
                            MPI_Fint* count,
                            MPI_Fint* ierr)
{
  MPI_Status  c_status;
  MPI_Status* c_status_ptr = &c_status;

  PMPI_Status_f2c(status, c_status_ptr);

  *ierr = MPI_Get_elements(c_status_ptr, PMPI_Type_f2c(*datatype), count);
}

#endif
#if defined(HAS_MPI_GET_PROCESSOR_NAME) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Get_processor_name
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 1.0
 * @ingroup ext
 */
void FSUB(MPI_Get_processor_name)(char*     name,
                                  MPI_Fint* resultlen,
                                  MPI_Fint* ierr,
                                  int       name_len)
{
  char* c_name     = NULL;
  int   c_name_len = 0;

  c_name = (char*)malloc((name_len + 1) * sizeof (char));
  if (!c_name)
  {
    exit(EXIT_FAILURE);
  }

  *ierr = MPI_Get_processor_name(c_name, resultlen);

  c_name_len = strlen(c_name);
  strncpy(name, c_name, c_name_len);
  memset(name + c_name_len, ' ', name_len - c_name_len);
  free(c_name);
}

#endif
#if defined(HAS_MPI_GREQUEST_COMPLETE) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Grequest_complete
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Grequest_complete)(MPI_Fint* request,
                                 MPI_Fint* ierr)
{
  MPI_Request c_request = PMPI_Request_f2c(*request);

  *ierr = MPI_Grequest_complete(c_request);

  *request = PMPI_Request_c2f(c_request);
}

#endif
#if defined(HAS_MPI_GREQUEST_START) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Grequest_start
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Grequest_start)(void*     query_fn,
                              void*     free_fn,
                              void*     cancel_fn,
                              void*     extra_state,
                              MPI_Fint* request,
                              MPI_Fint* ierr)
{
  MPI_Request c_request;

  *ierr =
    MPI_Grequest_start((MPI_Grequest_query_function*)query_fn,
                       (MPI_Grequest_free_function*)free_fn,
                       (MPI_Grequest_cancel_function*)cancel_fn,
                       extra_state,
                       &c_request);

  *request = PMPI_Request_c2f(c_request);
}

#endif
#if defined(HAS_MPI_STATUS_SET_CANCELLED) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_MISC)
/**
 * Measurement wrapper for MPI_Status_set_cancelled
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Status_set_cancelled)(MPI_Fint* status,
                                    MPI_Fint* flag,
                                    MPI_Fint* ierr)
{
  MPI_Status  c_status;
  MPI_Status* c_status_ptr = &c_status;

  PMPI_Status_f2c(status, c_status_ptr);

  *ierr = MPI_Status_set_cancelled(c_status_ptr, *flag);

  #if defined(HAS_MPI_STATUS_IGNORE)
  if (c_status_ptr != MPI_STATUS_IGNORE)
  #endif
  {
    PMPI_Status_c2f(c_status_ptr, status);
  }
}

#endif
#if defined(HAS_MPI_STATUS_SET_ELEMENTS) && !defined(NO_MPI_EXTRA) \
  && !defined(NO_MPI_EXT)
/**
 * Measurement wrapper for MPI_Status_set_elements
 * @note Auto-generated by wrapgen from template: f2c_c2f.w
 * @note Fortran interface
 * @note Introduced with MPI 2.0
 * @ingroup ext
 */
void FSUB(MPI_Status_set_elements)(MPI_Fint* status,
                                   MPI_Fint* datatype,
                                   MPI_Fint* count,
                                   MPI_Fint* ierr)
{
  MPI_Status  c_status;
  MPI_Status* c_status_ptr = &c_status;

  PMPI_Status_f2c(status, c_status_ptr);

  *ierr = MPI_Status_set_elements(c_status_ptr, PMPI_Type_f2c(
                                    *datatype), *count);

  #if defined(HAS_MPI_STATUS_IGNORE)
  if (c_status_ptr != MPI_STATUS_IGNORE)
  #endif
  {
    PMPI_Status_c2f(c_status_ptr, status);
  }
}

#endif

#endif

/**
 * @}
 */
