mpe_proff.c

fortran并行计算包

/*
   (C) 2001 by Argonne National Laboratory.
       See COPYRIGHT in top-level directory.
*/
/* myprof.c */
/* Custom Fortran interface file */
/* These have been edited because they require special string processing */
/* See mpe_prof.c for what these are interfacing to */

/* 
 * If not building for MPICH, then MPE_ErrPrint and the mpi_iargc_/mpir_getarg_
 * calls need to be replaced.
 */

#ifdef MPI_BUILD_PROFILING
#undef MPI_BUILD_PROFILING
#endif
#include "mpe_conf.h"
#include "mpe_wrappers_conf.h"
#include "mpi.h"

/* AIX requires this to be the first thing in the file.  */
#ifndef __GNUC__
# if HAVE_ALLOCA_H
#  include <alloca.h>
# else
#  ifdef _AIX
 #pragma alloca
#  else
#   ifndef alloca /* predefined by HP cc +Olibcalls */
char *alloca ();
#   endif
#  endif
# endif
#else
# if defined( HAVE_ALLOCA_H )
#  include <alloca.h>
# endif
#endif

#include <stdio.h>
#define MPE_ErrPrint(comm,errcode,str) (fprintf( stderr, "%s\n", str ),errcode)

#if defined( STDC_HEADERS ) || defined( HAVE_STDARG_H )
#include <stdarg.h>
#endif

#if ! defined( MPICH_NAME ) || defined ( MPICH2 )
#if defined( HAVE_STRING_H )
#include <string.h>
#endif
/* If we aren't running MPICH, just use fprintf for errors */
/* Also avoid Fortran arguments */
#define mpir_iargc_() 0
#define mpir_getarg_( idx, str, ln ) strncpy(str,"Unknown",ln)
#else
/* Make sure that we get the correct Fortran form */

#ifdef F77_NAME_UPPER
#define mpir_iargc_ MPIR_IARGC
#define mpir_getarg_ MPIR_GETARG
#elif defined(F77_NAME_LOWER_2USCORE)
#define mpir_iargc_ mpir_iargc__
#define mpir_getarg_ mpir_getarg__
#elif !defined(F77_NAME_LOWER_USCORE)
#define mpir_iargc_ mpir_iargc
#define mpir_getarg_ mpir_getarg
#endif

#endif

/* 
   Include a definition of MALLOC and FREE to allow the use of MPICH
   memory debug code 
*/
#if defined(MPIR_MEMDEBUG)
/* Enable memory tracing.  This requires MPICH's mpid/util/tr2.c codes */
#define MALLOC(a)    MPID_trmalloc((unsigned)(a),__LINE__,__FILE__)
#define FREE(a)      MPID_trfree(a,__LINE__,__FILE__)

#else
#define MALLOC(a) malloc(a)
#define FREE(a)   free(a)
#define MPID_trvalid(a)
#ifdef HAVE_STDLIB_H
#include <stdlib.h>
#endif
#endif

#ifndef DEBUG_ALL
#define DEBUG_ALL
#endif

/* Fortran logical values */
MPI_Fint MPER_F_TRUE = MPE_F77_TRUE_VALUE;
MPI_Fint MPER_F_FALSE = MPE_F77_FALSE_VALUE;

/* Fortran logical values */
#if defined( WITH_CRAY_FCD_LOGICAL )
/*
   CRAY Vector processors only; these are defined in /usr/include/fortran.h 
   Thanks to [e-mail]
*/
#include <fortran.h>
#define MPIR_TO_FLOG(a) (_btol(a))
#define MPIR_FROM_FLOG(a) ( _ltob(&(a)) )    /*(a) must be a pointer */

#else
/*  extern MPI_Fint MPER_F_TRUE, MPER_F_FALSE;  */
#define MPIR_TO_FLOG(a) ((a) ? MPER_F_TRUE : MPER_F_FALSE)
/* 
   Note on true and false.  This code is only an approximation.
   Some systems define either true or false, and allow some or ALL other
   patterns for the other.  This is just like C, where 0 is false and 
   anything not zero is true.  Modify this test as necessary for your
   system.
 */
#define MPIR_FROM_FLOG(a) ( (a) == MPER_F_TRUE ? 1 : 0 )
#endif

/* MPIR_F_MPI_BOTTOM is the address of the Fortran MPI_BOTTOM value */
extern void *MPIR_F_MPI_BOTTOM;

/* A temporary until we can make this do
   MPIR_F_PTR(a) (((a)==(MPIR_F_MPI_BOTTOM))?MPI_BOTTOM:a) 
*/
#define MPIR_F_PTR(a) (a)

/* Error handling */
#if defined(USE_STDARG) && !defined(USE_OLDSTYLE_STDARG)
int MPER_Err_setmsg( int, int, const char *, const char *, const char *, ... );
#else
int MPER_Err_setmsg();
#endif

#ifndef MPIR_ERR_DEFAULT
#define MPIR_ERR_DEFAULT 1
#endif

#ifndef MPIR_ERROR
#define MPIR_ERROR(a,b,c) fprintf(stderr, "%s\n", c )
#endif

#ifndef MPIR_FALLOC
#define MPIR_FALLOC(ptr,expr,a,b,c) \
    if (! (ptr = (expr))) { MPIR_ERROR(a,b,c); }
#endif

#ifndef MPIR_USE_LOCAL_ARRAY
#define MPIR_USE_LOCAL_ARRAY 32
#endif

#ifndef HAVE_MPI_COMM_F2C
#define MPI_Comm_c2f(comm) (MPI_Fint)(comm)
#define MPI_Comm_f2c(comm) (MPI_Comm)(comm)
#endif
#ifndef HAVE_MPI_TYPE_F2C
#define MPI_Type_c2f(datatype) (MPI_Fint)(datatype)
#define MPI_Type_f2c(datatype) (MPI_Datatype)(datatype)
#endif
#ifndef HAVE_MPI_GROUP_F2C
#define MPI_Group_c2f(group) (MPI_Fint)(group)
#define MPI_Group_f2c(group) (MPI_Group)(group)
#endif
#ifndef HAVE_MPI_REQUEST_F2C
#define MPI_Request_c2f(request) (MPI_Fint)(request)
#define MPI_Request_f2c(request) (MPI_Request)(request)
#endif
#ifndef HAVE_MPI_OP_F2C
#define MPI_Op_c2f(op) (MPI_Fint)(op)
#define MPI_Op_f2c(op) (MPI_Op)(op)
#endif
#ifndef HAVE_MPI_ERRHANDLER_F2C
#define MPI_Errhandler_c2f(errhandler) (MPI_Fint)(errhandler)
#define MPI_Errhandler_f2c(errhandler) (MPI_Errhandler)(errhandler)
#endif
#ifndef HAVE_MPI_STATUS_F2C
#define MPI_Status_f2c(f_status,c_status) memcpy(c_status,f_status,sizeof(MPI_Status))
#define MPI_Status_c2f(c_status,f_status) memcpy(f_status,c_status,sizeof(MPI_Status))
#endif

#ifdef F77_NAME_UPPER
#define mpi_init_ MPI_INIT
#define mpi_init_thread_ MPI_INIT_THREAD
#define mpi_pcontrol_ MPI_PCONTROL
#define mpi_comm_create_ MPI_COMM_CREATE
#define mpi_comm_dup_ MPI_COMM_DUP
#define mpe_comm_free_ MPI_COMM_FREE
#define mpi_comm_split_ MPI_COMM_SPLIT
#define mpi_intercomm_create_ MPI_INTERCOMM_CREATE
#define mpi_intercomm_merge_ MPI_INTERCOMM_MERGE
#define mpi_cart_create_ MPI_CART_CREATE
#define mpi_cart_sub_ MPI_CART_SUB
#define mpi_graph_create_ MPI_GRAPH_CREATE
#define mpi_bsend_ MPI_BSEND
#define mpi_bsend_init_ MPI_BSEND_INIT
#define mpi_buffer_attach_ MPI_BUFFER_ATTACH
#define mpi_buffer_detach_ MPI_BUFFER_DETACH
#define mpi_cancel_ MPI_CANCEL
#define mpi_request_free_ MPI_REQUEST_FREE
#define mpi_recv_init_ MPI_RECV_INIT
#define mpi_send_init_ MPI_SEND_INIT
#define mpi_get_count_ MPI_GET_COUNT
#define mpi_get_elements_ MPI_GET_ELEMENTS
#define mpi_ibsend_ MPI_IBSEND
#define mpi_iprobe_ MPI_IPROBE
#define mpi_irecv_ MPI_IRECV
#define mpi_irsend_ MPI_IRSEND
#define mpi_isend_ MPI_ISEND
#define mpi_issend_ MPI_ISSEND
#define mpi_pack_size_ MPI_PACK_SIZE
#define mpi_pack_ MPI_PACK
#define mpi_probe_ MPI_PROBE
#define mpi_recv_ MPI_RECV
#define mpi_rsend_init_ MPI_RSEND_INIT
#define mpi_rsend_ MPI_RSEND
#define mpi_send_ MPI_SEND
#define mpi_sendrecv_ MPI_SENDRECV
#define mpi_sendrecv_replace_ MPI_SENDRECV_REPLACE
#define mpi_ssend_init_ MPI_SSEND_INIT
#define mpi_ssend_ MPI_SSEND
#define mpi_startall_ MPI_STARTALL
#define mpi_start_ MPI_START
#define mpi_testall_ MPI_TESTALL
#define mpi_testany_ MPI_TESTANY
#define mpi_test_canceled_ MPI_TESTCANCEL
#define mpi_test_ MPI_TEST
#define mpi_testsome_ MPI_TESTSOME
#define mpi_type_commit_ MPI_TYPE_COMMIT
#define mpi_type_contiguous_ MPI_TYPE_CONTIGUOUS
#define mpi_type_extent_ MPI_TYPE_EXTENT
#define mpi_type_free_ MPI_TYPE_FREE
#define mpi_type_hindexed_ MPI_TYPE_HINDEXED
#define mpi_type_hvector_ MPI_TYPE_HVECTOR
#define mpi_type_indexed_ MPI_TYPE_INDEXED
#define mpi_type_lb_ MPI_TYPE_LB
#define mpi_type_size_ MPI_TYPE_SIZE
#define mpi_type_struct_ MPI_TYPE_STRUCT
#define mpi_type_ub_ MPI_TYPE_UB
#define mpi_type_vector_ MPI_TYPE_VECTOR
#define mpi_unpack_ MPI_UNPACK
#define mpi_waitall_ MPI_WAITALL
#define mpi_waitany_ MPI_WAITANY
#define mpi_wait_ MPI_WAIT
#define mpi_waitsome_ MPI_WAITSOME
#define mpi_allgather_ MPI_ALLGATHER
#define mpi_allgatherv_ MPI_ALLGATHERV
#define mpi_allreduce_ MPI_ALLREDUCE
#define mpi_alltoall_ MPI_ALLTOALL
#define mpi_alltoallv_ MPI_ALLTOALLV
#define mpi_barrier_ MPI_BARRIER
#define mpi_bcast_ MPI_BCAST
#define mpi_gather_ MPI_GATHER
#define mpi_gatherv_ MPI_GATHERV
#define mpi_op_create_ MPI_OP_CREATE
#define mpi_op_free_ MPI_OP_FREE
#define mpi_reduce_scatter_ MPI_REDUCE_SCATTER
#define mpi_reduce_ MPI_REDUCE
#define mpi_scan_ MPI_SCAN
#define mpi_scatter_ MPI_SCATTER
#define mpi_scatterv_ MPI_SCATTERV
#define mpi_finalize_ MPI_FINALIZE
#elif defined(F77_NAME_LOWER_2USCORE)
#define mpi_init_ mpi_init__
#define mpi_init_thread_ mpi_init_thread__
#define mpi_pcontrol_ mpi_pcontrol__
#define mpi_comm_create_ mpi_comm_create__
#define mpi_comm_dup_ mpi_comm_dup__
#define mpe_comm_free_ mpi_comm_free__
#define mpi_comm_split_ mpi_comm_split__
#define mpi_intercomm_create_ mpi_intercomm_create__
#define mpi_intercomm_merge_ mpi_intercomm_merge__
#define mpi_cart_create_ mpi_cart_create__
#define mpi_cart_sub_ mpi_cart_sub__
#define mpi_graph_create_ mpi_graph_create__
#define mpi_bsend_ mpi_bsend__
#define mpi_bsend_init_ mpi_bsend_init__
#define mpi_buffer_attach_ mpi_buffer_attach__
#define mpi_buffer_detach_ mpi_buffer_detach__
#define mpi_cancel_ mpi_cancel__
#define mpi_request_free_ mpi_request_free__
#define mpi_recv_init_ mpi_recv_init__
#define mpi_send_init_ mpi_send_init__
#define mpi_get_count_ mpi_get_count__
#define mpi_get_elements_ mpi_get_elements__
#define mpi_ibsend_ mpi_ibsend__
#define mpi_iprobe_ mpi_iprobe__
#define mpi_irecv_ mpi_irecv__
#define mpi_irsend_ mpi_irsend__
#define mpi_isend_ mpi_isend__
#define mpi_issend_ mpi_issend__
#define mpi_pack_size_ mpi_pack_size__
#define mpi_pack_ mpi_pack__
#define mpi_probe_ mpi_probe__
#define mpi_recv_ mpi_recv__
#define mpi_rsend_init_ mpi_rsend_init__
#define mpi_rsend_ mpi_rsend__
#define mpi_send_ mpi_send__
#define mpi_sendrecv_ mpi_sendrecv__
#define mpi_sendrecv_replace_ mpi_sendrecv_replace__
#define mpi_ssend_init_ mpi_ssend_init__
#define mpi_ssend_ mpi_ssend__
#define mpi_startall_ mpi_startall__
#define mpi_start_ mpi_start__
#define mpi_testall_ mpi_testall__
#define mpi_testany_ mpi_testany__
#define mpi_test_cancelled_ mpi_test_cancelled__
#define mpi_test_ mpi_test__
#define mpi_testsome_ mpi_testsome__
#define mpi_type_commit_ mpi_type_commit__
#define mpi_type_contiguous_ mpi_type_contiguous__
#define mpi_type_extent_ mpi_type_extent__
#define mpi_type_free_ mpi_type_free__
#define mpi_type_hindexed_ mpi_type_hindexed__
#define mpi_type_hvector_ mpi_type_hvector__
#define mpi_type_indexed_ mpi_type_indexed__
#define mpi_type_lb_ mpi_type_lb__
#define mpi_type_size_ mpi_type_size__
#define mpi_type_struct_ mpi_type_struct__
#define mpi_type_ub_ mpi_type_ub__
#define mpi_type_vector_ mpi_type_vector__
#define mpi_unpack_ mpi_unpack__
#define mpi_waitall_ mpi_waitall__
#define mpi_waitany_ mpi_waitany__
#define mpi_wait_ mpi_wait__
#define mpi_waitsome_ mpi_waitsome__
#define mpi_allgather_ mpi_allgather__
#define mpi_allgatherv_ mpi_allgatherv__
#define mpi_allreduce_ mpi_allreduce__
#define mpi_alltoall_ mpi_alltoall__
#define mpi_alltoallv_ mpi_alltoallv__
#define mpi_barrier_ mpi_barrier__
#define mpi_bcast_ mpi_bcast__
#define mpi_gather_ mpi_gather__
#define mpi_gatherv_ mpi_gatherv__
#define mpi_op_create_ mpi_op_create__
#define mpi_op_free_ mpi_op_free__
#define mpi_reduce_scatter_ mpi_reduce_scatter__
#define mpi_reduce_ mpi_reduce__
#define mpi_scan_ mpi_scan__
#define mpi_scatter_ mpi_scatter__
#define mpi_scatterv_ mpi_scatterv__
#define mpi_finalize_ mpi_finalize__
#elif defined(F77_NAME_LOWER)
#define mpi_init_ mpi_init
#define mpi_init_thread_ mpi_init_thread
#define mpi_pcontrol_ mpi_pcontrol
#define mpi_comm_create_ mpi_comm_create
#define mpi_comm_dup_ mpi_comm_dup
#define mpe_comm_free_ mpi_comm_free
#define mpi_comm_split_ mpi_comm_split
#define mpi_intercomm_create_ mpi_intercomm_create
#define mpi_intercomm_merge_ mpi_intercomm_merge
#define mpi_cart_create_ mpi_cart_create
#define mpi_cart_sub_ mpi_cart_sub
#define mpi_graph_create_ mpi_graph_create
#define mpi_bsend_ mpi_bsend
#define mpi_bsend_init_ mpi_bsend_init
#define mpi_buffer_attach_ mpi_buffer_attach
#define mpi_buffer_detach_ mpi_buffer_detach
#define mpi_cancel_ mpi_cancel
#define mpi_request_free_ mpi_request_free
#define mpi_recv_init_ mpi_recv_init
#define mpi_send_init_ mpi_send_init
#define mpi_get_count_ mpi_get_count
#define mpi_get_elements_ mpi_get_elements
#define mpi_ibsend_ mpi_ibsend
#define mpi_iprobe_ mpi_iprobe
#define mpi_irecv_ mpi_irecv
#define mpi_irsend_ mpi_irsend
#define mpi_isend_ mpi_isend
#define mpi_issend_ mpi_issend
#define mpi_pack_size_ mpi_pack_size
#define mpi_pack_ mpi_pack
#define mpi_probe_ mpi_probe
#define mpi_recv_ mpi_recv
#define mpi_rsend_init_ mpi_rsend_init
#define mpi_rsend_ mpi_rsend
#define mpi_send_ mpi_send