diff --git a/src/externals/mct/mpi-serial/Makefile b/src/externals/mct/mpi-serial/Makefile index 024d9f86241..7122f7423f4 100644 --- a/src/externals/mct/mpi-serial/Makefile +++ b/src/externals/mct/mpi-serial/Makefile @@ -18,6 +18,8 @@ SRCS_C = mpi.c \ list.c \ handles.c \ comm.c \ + error.c \ + ic_merge.c \ group.c \ time.c \ pack.c \ @@ -86,6 +88,3 @@ install: lib $(INSTALL) lib$(MODULE).a -m 644 $(libdir) $(INSTALL) mpi.h -m 644 $(includedir) $(INSTALL) mpif.h -m 644 $(includedir) - - - diff --git a/src/externals/mct/mpi-serial/README b/src/externals/mct/mpi-serial/README index 20e377602bc..aaa728501f9 100644 --- a/src/externals/mct/mpi-serial/README +++ b/src/externals/mct/mpi-serial/README @@ -64,6 +64,9 @@ List of MPI calls supported mpi_abort mpi_error_string mpi_initialized + mpi_get_processor_name + mpi_get_library_version + mpi_wtime comm and group ops mpi_comm_free @@ -74,17 +77,36 @@ List of MPI calls supported mpi_comm_split mpi_comm_group mpi_group_incl + mpi_group_range_incl + mpi_group_union + mpi_group_intersection + mpi_group_difference + mpi_group_translate_ranks mpi_group_free + mpi_cart_create + mpi_cart_coords + mpi_dims_create send/receive ops mpi_irecv mpi_recv mpi_test + mpi_testany + mpi_testall + mpi_testsome mpi_wait mpi_waitany mpi_waitall + mpi_waitsome mpi_isend mpi_send + mpi_ssend + mpi_rsend + mpi_irsend + mpi_sendrecv + mpi_iprobe + mpi_probe + mpi_request_free collective operations mpi_barrier @@ -92,11 +114,27 @@ List of MPI calls supported mpi_gather mpi_gatherv mpi_allgather + mpi_scatter mpi_scatterv mpi_reduce mpi_allreduce - - + mpi_reduce_scatter + mpi_scan + mpi_alltoall + mpi_alltoallv + mpi_alltoallw + mpi_op_create + mpi_op_free + + data types and info objects + mpi_get_count + mpi_get_elements + mpi_pack + mpi_pack_size + mpi_unpack + mpi_info_create + mpi_info_set + mpi_info_free ----- EOF diff --git a/src/externals/mct/mpi-serial/collective.c b/src/externals/mct/mpi-serial/collective.c index cead061130f..9a9736b4b64 100644 --- a/src/externals/mct/mpi-serial/collective.c +++ b/src/externals/mct/mpi-serial/collective.c @@ -488,27 +488,6 @@ int MPI_Alltoallw(void *sendbuf, int *sendcounts, } -/*********/ - - -FC_FUNC( mpi_op_create , MPI_OP_CREATE ) - ( void *function, int *commute, int *op, int *ierror ) -{ - *ierror=MPI_Op_create(function,*commute,op); -} - - - -int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op) -{ - *op=MPI_OP_NULL; - - return(MPI_SUCCESS); - -} - - - /*********/ diff --git a/src/externals/mct/mpi-serial/error.c b/src/externals/mct/mpi-serial/error.c new file mode 100644 index 00000000000..d26cfd164f9 --- /dev/null +++ b/src/externals/mct/mpi-serial/error.c @@ -0,0 +1,13 @@ + +#include "mpiP.h" + +/* + * Error handling code + * Just a stub for now to support the MPI interface without actually + * doing anything + */ + + int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler handle) + { + return(MPI_SUCCESS); + } diff --git a/src/externals/mct/mpi-serial/ic_merge.c b/src/externals/mct/mpi-serial/ic_merge.c new file mode 100644 index 00000000000..ea19b387155 --- /dev/null +++ b/src/externals/mct/mpi-serial/ic_merge.c @@ -0,0 +1,15 @@ + +#include "mpiP.h" + +/* + * MPI_Intercomm_merge - Creates an intracommunicator from an intercommunicator + * This is just a stub for now to support mpi function calls even in Serial + * applications. In the case of a serial program, this function is a no-op and + * only ever returns MPI_SUCCESS + */ + +int MPI_Intercomm_merge( MPI_Comm intercomm, int high, MPI_Comm *newintracomm ) +{ + newintracomm = (MPI_Comm *)intercomm; + return(MPI_SUCCESS); +} diff --git a/src/externals/mct/mpi-serial/mpi.h b/src/externals/mct/mpi-serial/mpi.h index 529b57b853a..9183bf89d20 100644 --- a/src/externals/mct/mpi-serial/mpi.h +++ b/src/externals/mct/mpi-serial/mpi.h @@ -1,4 +1,3 @@ - #ifndef _MPI_H_ #define _MPI_H_ @@ -48,7 +47,6 @@ typedef int MPI_Group; #define MPI_ERR_IN_STATUS (-1) #define MPI_ERR_LASTCODE (-1) - /* * MPI_UNDEFINED * @@ -191,6 +189,14 @@ typedef struct /* Fortran: INTEGER status(MPI_STATUS_SIZE) */ #define MPI_STATUSES_IGNORE ((MPI_Status *)0) +/* + * MPI Errhandling stubs (Not functional currently) + */ +typedef int MPI_Errhandler; + +#define MPI_ERRORS_ARE_FATAL ((MPI_Errhandler)0) +#define MPI_ERRORS_RETURN ((MPI_Errhandler)-1) + /* * Collective operations @@ -246,7 +252,8 @@ typedef int MPI_Info; /* handle */ extern int MPI_Intercomm_create(MPI_Comm local_comm, int local_leader, MPI_Comm peer_comm, int remote_leader, int tag, MPI_Comm *newintercomm); - +extern int MPI_Intercomm_merge(MPI_Comm intercomm, int high, + MPI_Comm *newintercomm); extern int MPI_Cart_create(MPI_Comm comm_old, int ndims, int *dims, int *periods, int reorder, MPI_Comm *comm_cart); extern int MPI_Cart_get(MPI_Comm comm, int maxdims, int *dims, @@ -389,6 +396,9 @@ extern int MPI_Iprobe(int source, int tag, MPI_Comm comm, extern int MPI_Pack_size(int incount, MPI_Datatype type, MPI_Comm comm, MPI_Aint * size); +/* Error handling stub, not currently functional */ +extern int MPI_Errhandler_set(MPI_Comm comm, MPI_Errhandler handle); + /* new type functions */ extern int MPI_Get_count(MPI_Status *status, MPI_Datatype datatype, int *count); extern int MPI_Get_elements(MPI_Status *status, MPI_Datatype datatype, int *count); @@ -400,6 +410,9 @@ extern int MPI_Type_vector(int count, int blocklen, int stride, MPI_Datatype old extern int MPI_Type_hvector(int count, int blocklen, MPI_Aint stride, MPI_Datatype oldtype, MPI_Datatype *newtype); +extern int MPI_Type_create_hvector(int count, int blocklen, MPI_Aint stride, + MPI_Datatype oldtype, MPI_Datatype *newtype); + extern int MPI_Type_indexed(int count, int *blocklens, int *displacements, MPI_Datatype oldtype, MPI_Datatype *newtype); diff --git a/src/externals/mct/mpi-serial/mpif.h b/src/externals/mct/mpi-serial/mpif.h index b8071791e4b..b4537b5d4a2 100644 --- a/src/externals/mct/mpi-serial/mpif.h +++ b/src/externals/mct/mpi-serial/mpif.h @@ -1,334 +1,327 @@ -!!! -!!! NOTE: The files mpif.realXdoubleY.h are generated from -!!! mpif.master.h using make-mpif and later copied to mpif.h -!!! during the library make. All modifications should be -!!! made to mpif.master.h -!!! - - ! ! MPI_COMM_WORLD ! - INTEGER MPI_COMM_WORLD - parameter (mpi_comm_world=1) +INTEGER MPI_COMM_WORLD +parameter (mpi_comm_world=1) ! ! ! - integer MPI_BOTTOM - parameter (MPI_BOTTOM=0) +integer MPI_BOTTOM +parameter (MPI_BOTTOM=0) ! ! source,tag -! + ! - integer MPI_ANY_SOURCE, MPI_ANY_TAG - parameter (mpi_any_source=-1, mpi_any_tag= -1) + integer MPI_ANY_SOURCE, MPI_ANY_TAG, MPI_TAG_UB + parameter (mpi_any_source=-1, mpi_any_tag= -1, mpi_tag_ub=1681915906) - integer MPI_PROC_NULL, MPI_ROOT - parameter (MPI_PROC_NULL=-2, MPI_ROOT=-3) + integer MPI_PROC_NULL, MPI_ROOT + parameter (MPI_PROC_NULL=-2, MPI_ROOT=-3) - integer MPI_COMM_NULL, MPI_REQUEST_NULL - parameter (MPI_COMM_NULL=0, MPI_REQUEST_NULL=0) + integer MPI_COMM_NULL, MPI_REQUEST_NULL + parameter (MPI_COMM_NULL=0, MPI_REQUEST_NULL=0) - integer MPI_GROUP_NULL, MPI_GROUP_EMPTY - parameter (MPI_GROUP_NULL=0, MPI_GROUP_EMPTY= -1) + integer MPI_GROUP_NULL, MPI_GROUP_EMPTY + parameter (MPI_GROUP_NULL=0, MPI_GROUP_EMPTY= -1) - integer MPI_MAX_ERROR_STRING - parameter (MPI_MAX_ERROR_STRING=128) + integer MPI_MAX_ERROR_STRING + parameter (MPI_MAX_ERROR_STRING=128) - integer MPI_MAX_PROCESSOR_NAME - parameter (MPI_MAX_PROCESSOR_NAME=128) + integer MPI_MAX_PROCESSOR_NAME + parameter (MPI_MAX_PROCESSOR_NAME=128) -! -! Return codes -! + ! + ! Return codes + ! - integer MPI_SUCCESS - parameter (MPI_SUCCESS=0) + integer MPI_SUCCESS + parameter (MPI_SUCCESS=0) - integer MPI_ERR_BUFFER - parameter (MPI_ERR_BUFFER= -1) + integer MPI_ERR_BUFFER + parameter (MPI_ERR_BUFFER= -1) - integer MPI_ERR_COUNT - parameter (MPI_ERR_COUNT= -1) + integer MPI_ERR_COUNT + parameter (MPI_ERR_COUNT= -1) - integer MPI_ERR_TYPE - parameter (MPI_ERR_TYPE= -1) + integer MPI_ERR_TYPE + parameter (MPI_ERR_TYPE= -1) - integer MPI_ERR_TAG - parameter (MPI_ERR_TAG= -1) + integer MPI_ERR_TAG + parameter (MPI_ERR_TAG= -1) - integer MPI_ERR_COMM - parameter (MPI_ERR_COMM= -1) + integer MPI_ERR_COMM + parameter (MPI_ERR_COMM= -1) - integer MPI_ERR_RANK - parameter (MPI_ERR_RANK= -1) + integer MPI_ERR_RANK + parameter (MPI_ERR_RANK= -1) - integer MPI_ERR_REQUEST - parameter (MPI_ERR_REQUEST= -1) + integer MPI_ERR_REQUEST + parameter (MPI_ERR_REQUEST= -1) - integer MPI_ERR_ROOT - parameter (MPI_ERR_ROOT= -1) + integer MPI_ERR_ROOT + parameter (MPI_ERR_ROOT= -1) - integer MPI_ERR_GROUP - parameter (MPI_ERR_GROUP= -1) + integer MPI_ERR_GROUP + parameter (MPI_ERR_GROUP= -1) - integer MPI_ERR_OP - parameter (MPI_ERR_OP= -1) + integer MPI_ERR_OP + parameter (MPI_ERR_OP= -1) - integer MPI_ERR_TOPOLOGY - parameter (MPI_ERR_TOPOLOGY= -1) + integer MPI_ERR_TOPOLOGY + parameter (MPI_ERR_TOPOLOGY= -1) - integer MPI_ERR_DIMS - parameter (MPI_ERR_DIMS= -1) + integer MPI_ERR_DIMS + parameter (MPI_ERR_DIMS= -1) - integer MPI_ERR_ARG - parameter (MPI_ERR_ARG= -1) + integer MPI_ERR_ARG + parameter (MPI_ERR_ARG= -1) - integer MPI_ERR_UNKNOWN - parameter (MPI_ERR_UNKNOWN= -1) + integer MPI_ERR_UNKNOWN + parameter (MPI_ERR_UNKNOWN= -1) - integer MPI_ERR_TRUNCATE - parameter (MPI_ERR_TRUNCATE= -1) + integer MPI_ERR_TRUNCATE + parameter (MPI_ERR_TRUNCATE= -1) - integer MPI_ERR_OTHER - parameter (MPI_ERR_OTHER= -1) + integer MPI_ERR_OTHER + parameter (MPI_ERR_OTHER= -1) - integer MPI_ERR_INTERN - parameter (MPI_ERR_INTERN= -1) + integer MPI_ERR_INTERN + parameter (MPI_ERR_INTERN= -1) - integer MPI_PENDING - parameter (MPI_PENDING= -1) + integer MPI_PENDING + parameter (MPI_PENDING= -1) - integer MPI_ERR_IN_STATUS - parameter (MPI_ERR_IN_STATUS= -1) + integer MPI_ERR_IN_STATUS + parameter (MPI_ERR_IN_STATUS= -1) - integer MPI_ERR_LASTCODE - parameter (MPI_ERR_LASTCODE= -1) + integer MPI_ERR_LASTCODE + parameter (MPI_ERR_LASTCODE= -1) -! -! + integer MPI_ERRORS_RETURN + parameter (MPI_ERRORS_RETURN= -1) + ! + ! - integer MPI_UNDEFINED - parameter (MPI_UNDEFINED= -1) + integer MPI_UNDEFINED + parameter (MPI_UNDEFINED= -1) -! -! MPI_Status -! -! The values in this section MUST match the struct definition -! in mpi.h -! + ! + ! MPI_Status + ! + ! The values in this section MUST match the struct definition + ! in mpi.h + ! - INTEGER MPI_STATUS_SIZE - PARAMETER (MPI_STATUS_SIZE=4) - INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR - PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) - ! There is a 4th value only used internally + INTEGER MPI_STATUS_SIZE + PARAMETER (MPI_STATUS_SIZE=4) - INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) - INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) - COMMON /MPISERIAL/ MPI_STATUS_IGNORE - COMMON /MPISERIAL/ MPI_STATUSES_IGNORE + INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR + PARAMETER(MPI_SOURCE=1, MPI_TAG=2, MPI_ERROR=3) + ! There is a 4th value only used internally -! -! MPI_IN_PLACE -! + INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE) + INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) + COMMON /MPISERIAL/ MPI_STATUS_IGNORE + COMMON /MPISERIAL/ MPI_STATUSES_IGNORE - INTEGER MPI_IN_PLACE - COMMON /MPISERIAL/ MPI_IN_PLACE + ! + ! MPI_IN_PLACE + ! - SAVE /MPISERIAL/ ! Technically needed in case goes out of scope + INTEGER MPI_IN_PLACE + COMMON /MPISERIAL/ MPI_IN_PLACE + SAVE /MPISERIAL/ ! Technically needed in case goes out of scope -! -! MPI_Datatype values -! -! New datatype values -! Type constants represent integer handles, matching up to the index of the -! type array equal to the absolute value of the constant plus one. For -! example, MPI_BYTE=-12, corresponding to type index 11. -! (Array in type_const.c) -! + ! + ! MPI_Datatype values + ! + ! New datatype values + ! Type constants represent integer handles, matching up to the index of the + ! type array equal to the absolute value of the constant plus one. For + ! example, MPI_BYTE=-12, corresponding to type index 11. + ! (Array in type_const.c) + ! - INTEGER MPI_DATATYPE_NULL - PARAMETER (MPI_DATATYPE_NULL=0) - INTEGER MPI_BYTE - PARAMETER (MPI_BYTE=-12) + INTEGER MPI_DATATYPE_NULL + PARAMETER (MPI_DATATYPE_NULL=0) - INTEGER MPI_PACKED - PARAMETER (MPI_PACKED=-13) + INTEGER MPI_BYTE + PARAMETER (MPI_BYTE=-12) - INTEGER MPI_LB - PARAMETER (MPI_LB=-14) + INTEGER MPI_PACKED + PARAMETER (MPI_PACKED=-13) - INTEGER MPI_UB - PARAMETER (MPI_UB=-15) + INTEGER MPI_LB + PARAMETER (MPI_LB=-14) - INTEGER MPI_INTEGER - PARAMETER (MPI_INTEGER=-16) + INTEGER MPI_UB + PARAMETER (MPI_UB=-15) - INTEGER MPI_REAL - PARAMETER (MPI_REAL=-17) + INTEGER MPI_INTEGER + PARAMETER (MPI_INTEGER=-16) - INTEGER MPI_DOUBLE_PRECISION - PARAMETER (MPI_DOUBLE_PRECISION=-18) + INTEGER MPI_REAL + PARAMETER (MPI_REAL=-17) - INTEGER MPI_COMPLEX - PARAMETER (MPI_COMPLEX=-19) + INTEGER MPI_DOUBLE_PRECISION + PARAMETER (MPI_DOUBLE_PRECISION=-18) - INTEGER MPI_DOUBLE_COMPLEX - PARAMETER (MPI_DOUBLE_COMPLEX=-20) + INTEGER MPI_COMPLEX + PARAMETER (MPI_COMPLEX=-19) - INTEGER MPI_LOGICAL - PARAMETER (MPI_LOGICAL=-21) + INTEGER MPI_DOUBLE_COMPLEX + PARAMETER (MPI_DOUBLE_COMPLEX=-20) - INTEGER MPI_CHARACTER - PARAMETER (MPI_CHARACTER=-22) + INTEGER MPI_LOGICAL + PARAMETER (MPI_LOGICAL=-21) - integer MPI_2REAL - parameter (MPI_2REAL= -23) + INTEGER MPI_CHARACTER + PARAMETER (MPI_CHARACTER=-22) - integer MPI_2DOUBLE_PRECISION - parameter (MPI_2DOUBLE_PRECISION= -24) + integer MPI_2REAL + parameter (MPI_2REAL= -23) - integer MPI_2INTEGER - parameter (MPI_2INTEGER= -25) + integer MPI_2DOUBLE_PRECISION + parameter (MPI_2DOUBLE_PRECISION= -24) + integer MPI_2INTEGER + parameter (MPI_2INTEGER= -25) -! -! Size-specific types -! - INTEGER MPI_INTEGER1 - PARAMETER (MPI_INTEGER1= -32 ) + ! + ! Size-specific types + ! - INTEGER MPI_INTEGER2 - PARAMETER (MPI_INTEGER2= -33 ) + INTEGER MPI_INTEGER1 + PARAMETER (MPI_INTEGER1= -32 ) - INTEGER MPI_INTEGER4 - PARAMETER (MPI_INTEGER4= -34 ) + INTEGER MPI_INTEGER2 + PARAMETER (MPI_INTEGER2= -33 ) - INTEGER MPI_INTEGER8 - PARAMETER (MPI_INTEGER8= -35 ) + INTEGER MPI_INTEGER4 + PARAMETER (MPI_INTEGER4= -34 ) - INTEGER MPI_INTEGER16 - PARAMETER (MPI_INTEGER16= -36 ) + INTEGER MPI_INTEGER8 + PARAMETER (MPI_INTEGER8= -35 ) + INTEGER MPI_INTEGER16 + PARAMETER (MPI_INTEGER16= -36 ) - INTEGER MPI_REAL4 - PARAMETER (MPI_REAL4= -37 ) - INTEGER MPI_REAL8 - PARAMETER (MPI_REAL8= -38 ) + INTEGER MPI_REAL4 + PARAMETER (MPI_REAL4= -37 ) - INTEGER MPI_REAL16 - PARAMETER (MPI_REAL16= -39 ) + INTEGER MPI_REAL8 + PARAMETER (MPI_REAL8= -38 ) + INTEGER MPI_REAL16 + PARAMETER (MPI_REAL16= -39 ) - integer MPI_COMPLEX8 - parameter (MPI_COMPLEX8= -40 ) - integer MPI_COMPLEX16 - parameter (MPI_COMPLEX16= -41 ) + integer MPI_COMPLEX8 + parameter (MPI_COMPLEX8= -40 ) - integer MPI_COMPLEX32 - parameter (MPI_COMPLEX32= -42 ) + integer MPI_COMPLEX16 + parameter (MPI_COMPLEX16= -41 ) - integer MPI_LONG_LONG_INT - parameter (MPI_LONG_LONG_INT= -43) + integer MPI_COMPLEX32 + parameter (MPI_COMPLEX32= -42 ) - integer MPI_LONG_LONG - parameter (MPI_LONG_LONG= MPI_LONG_LONG_INT) + integer MPI_LONG_LONG_INT + parameter (MPI_LONG_LONG_INT= -43) - integer MPI_UNSIGNED_LONG_LONG - parameter (MPI_UNSIGNED_LONG_LONG= -44) + integer MPI_LONG_LONG + parameter (MPI_LONG_LONG= MPI_LONG_LONG_INT) - integer MPI_OFFSET - parameter (MPI_OFFSET= -45) + integer MPI_UNSIGNED_LONG_LONG + parameter (MPI_UNSIGNED_LONG_LONG= -44) -! -! MPI_Op values -! -! (All are handled as no-op so no value is necessary; but provide one -! anyway just in case.) -! - - INTEGER MPI_SUM - PARAMETER (MPI_SUM=0) - INTEGER MPI_MAX - PARAMETER (MPI_MAX=0) - INTEGER MPI_MIN - PARAMETER (MPI_MIN=0) - INTEGER MPI_PROD - PARAMETER (MPI_PROD=0) - INTEGER MPI_LAND - PARAMETER (MPI_LAND=0) - INTEGER MPI_BAND - PARAMETER (MPI_BAND=0) - INTEGER MPI_LOR - PARAMETER (MPI_LOR=0) - INTEGER MPI_BOR - PARAMETER (MPI_BOR=0) - INTEGER MPI_LXOR - PARAMETER (MPI_LXOR=0) - INTEGER MPI_BXOR - PARAMETER (MPI_BXOR=0) - INTEGER MPI_MINLOC - PARAMETER (MPI_MINLOC=0) - INTEGER MPI_MAXLOC - PARAMETER (MPI_MAXLOC=0) - INTEGER MPI_OP_NULL - PARAMETER (MPI_OP_NULL=0) + integer MPI_OFFSET + parameter (MPI_OFFSET= -45) -! -! MPI_Wtime -! + ! + ! MPI_Op values + ! + ! (All are handled as no-op so no value is necessary; but provide one + ! anyway just in case.) + ! - DOUBLE PRECISION MPI_WTIME - EXTERNAL MPI_WTIME + INTEGER MPI_SUM + PARAMETER (MPI_SUM=0) + INTEGER MPI_MAX + PARAMETER (MPI_MAX=0) + INTEGER MPI_MIN + PARAMETER (MPI_MIN=0) + INTEGER MPI_PROD + PARAMETER (MPI_PROD=0) + INTEGER MPI_LAND + PARAMETER (MPI_LAND=0) + INTEGER MPI_BAND + PARAMETER (MPI_BAND=0) + INTEGER MPI_LOR + PARAMETER (MPI_LOR=0) + INTEGER MPI_BOR + PARAMETER (MPI_BOR=0) + INTEGER MPI_LXOR + PARAMETER (MPI_LXOR=0) + INTEGER MPI_BXOR + PARAMETER (MPI_BXOR=0) + INTEGER MPI_MINLOC + PARAMETER (MPI_MINLOC=0) + INTEGER MPI_MAXLOC + PARAMETER (MPI_MAXLOC=0) + INTEGER MPI_OP_NULL + PARAMETER (MPI_OP_NULL=0) + ! + ! MPI_Wtime + ! -! -! Kinds -! + DOUBLE PRECISION MPI_WTIME + EXTERNAL MPI_WTIME - INTEGER MPI_OFFSET_KIND - PARAMETER (MPI_OFFSET_KIND=selected_int_kind(13)) - INTEGER MPI_MODE_RDONLY - PARAMETER (MPI_MODE_RDONLY=0) + ! + ! Kinds + ! - INTEGER MPI_MODE_CREATE - PARAMETER (MPI_MODE_CREATE=1) + INTEGER MPI_OFFSET_KIND + PARAMETER (MPI_OFFSET_KIND=selected_int_kind(13)) - INTEGER MPI_MODE_RDWR - PARAMETER (MPI_MODE_RDWR=2) + INTEGER MPI_MODE_RDONLY + PARAMETER (MPI_MODE_RDONLY=0) + INTEGER MPI_MODE_CREATE + PARAMETER (MPI_MODE_CREATE=1) -! -! Info -! + INTEGER MPI_MODE_RDWR + PARAMETER (MPI_MODE_RDWR=2) - INTEGER MPI_INFO_NULL - PARAMETER (MPI_INFO_NULL=0) + ! + ! Info + ! -! -! Library version string (must match C value) -! + INTEGER MPI_INFO_NULL + PARAMETER (MPI_INFO_NULL=0) - INTEGER MPI_MAX_LIBRARY_VERSION_STRING - PARAMETER (MPI_MAX_LIBRARY_VERSION_STRING=80) + ! + ! Library version string (must match C value) + ! + INTEGER MPI_MAX_LIBRARY_VERSION_STRING + PARAMETER (MPI_MAX_LIBRARY_VERSION_STRING=80) diff --git a/src/externals/mct/mpi-serial/tests/ftest_old.F90 b/src/externals/mct/mpi-serial/tests/ftest_old.F90 index 93075219def..1a35d2ef3ad 100644 --- a/src/externals/mct/mpi-serial/tests/ftest_old.F90 +++ b/src/externals/mct/mpi-serial/tests/ftest_old.F90 @@ -1,165 +1,163 @@ +program test + implicit none + include "mpif.h" - program test - implicit none - include "mpif.h" + integer ier - integer ier + integer sreq(10), sreq2(10), rreq(10), rreq2(10) + integer sbuf(10), sbuf2(10), rbuf(10), rbuf2(10) + integer tag + integer status(MPI_STATUS_SIZE,10) + integer i + integer comm2; + logical flag; + character pname(MPI_MAX_PROCESSOR_NAME) + integer pnamesize - integer sreq(10), sreq2(10), rreq(10), rreq2(10) - integer sbuf(10), sbuf2(10), rbuf(10), rbuf2(10) - integer tag - integer status(MPI_STATUS_SIZE,10) - integer i - integer comm2; - logical flag; - character pname(MPI_MAX_PROCESSOR_NAME) - integer pnamesize + integer temp,position + integer errcount - integer temp,position - integer errcount + errcount = 0 - errcount = 0 + print *, 'Time=',mpi_wtime() - print *, 'Time=',mpi_wtime() + call mpi_initialized(flag,ier) + print *, 'MPI is initialized=',flag - call mpi_initialized(flag,ier) - print *, 'MPI is initialized=',flag + call mpi_init(ier) - call mpi_init(ier) + call mpi_get_processor_name(pname,pnamesize,ier) + print *, 'proc name: "',pname(1:pnamesize),'" size:',pnamesize - call mpi_get_processor_name(pname,pnamesize,ier) - print *, 'proc name: "',pname(1:pnamesize),'" size:',pnamesize + call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier) - call mpi_comm_dup(MPI_COMM_WORLD,comm2,ier) + call mpi_initialized(flag,ier) + print *, 'MPI is initialized=',flag - call mpi_initialized(flag,ier) - print *, 'MPI is initialized=',flag + do i=1,5 + tag= 100+i + print *, 'Post receive tag ',tag - do i=1,5 - tag= 100+i - print *, 'Post receive tag ',tag + call mpi_irecv( rbuf(i),1,MPI_INTEGER,0,tag, & + MPI_COMM_WORLD,rreq(i),ier) - call mpi_irecv( rbuf(i),1,MPI_INTEGER,0,tag, & - MPI_COMM_WORLD,rreq(i),ier) + end do + do i=1,5 + ! tag=1100+i + ! print *, 'Post receive tag ',tag - end do - do i=1,5 -! tag=1100+i -! print *, 'Post receive tag ',tag + call mpi_irecv( rbuf2(i),1,MPI_INTEGER, & + MPI_ANY_SOURCE, MPI_ANY_TAG, & + comm2,rreq2(i),ier) - call mpi_irecv( rbuf2(i),1,MPI_INTEGER, & - MPI_ANY_SOURCE, MPI_ANY_TAG, & - comm2,rreq2(i),ier) + end do - end do + do i=1,5 + sbuf(i)=10*i + tag=100+i + print *, 'Send ',sbuf(i),' tag ',tag - do i=1,5 - sbuf(i)=10*i - tag=100+i - print *, 'Send ',sbuf(i),' tag ',tag + call mpi_isend( sbuf(i),1,MPI_INTEGER,0,tag, & + MPI_COMM_WORLD,sreq(i),ier) + end do - call mpi_isend( sbuf(i),1,MPI_INTEGER,0,tag, & - MPI_COMM_WORLD,sreq(i),ier) - end do + do i=1,5 + sbuf2(i)=1000+10*i + tag=1100+i + print *, 'Send ',sbuf2(i),' tag ',tag - do i=1,5 - sbuf2(i)=1000+10*i - tag=1100+i - print *, 'Send ',sbuf2(i),' tag ',tag + call mpi_isend( sbuf2(i),1,MPI_INTEGER,0,tag, & + comm2,sreq2(i),ier) + end do - call mpi_isend( sbuf2(i),1,MPI_INTEGER,0,tag, & - comm2,sreq2(i),ier) - end do + do i=1,5 + if (sbuf(i) .ne. rbuf(i)) then + errcount = errcount+1 + print *, 'error on Send2' + print *, 'found ',sbuf2(i),' should be ',rbuf2(i) + end if + end do - do i=1,5 - if (sbuf(i) .ne. rbuf(i)) then - errcount = errcount+1 - print *, 'error on Send2' - print *, 'found ',sbuf2(i),' should be ',rbuf2(i) - end if - end do + do i=1,5 + if (sbuf2(i) .ne. rbuf2(i)) then + errcount = errcount+1 + print *, 'error on Send2' + print *, 'found ',sbuf2(i),' should be ',rbuf2(i) + end if + end do - do i=1,5 - if (sbuf2(i) .ne. rbuf2(i)) then - errcount = errcount+1 - print *, 'error on Send2' - print *, 'found ',sbuf2(i),' should be ',rbuf2(i) - end if - end do + print *, 'Time=',mpi_wtime() + call mpi_waitall(5,sreq,status,ier) + print *,'sends on MPI_COMM_WORLD done' - print *, 'Time=',mpi_wtime() - call mpi_waitall(5,sreq,status,ier) - print *,'sends on MPI_COMM_WORLD done' + call mpi_waitall(5,rreq,status,ier) + print *,'recvs on MPI_COMM_WORLD done' - call mpi_waitall(5,rreq,status,ier) - print *,'recvs on MPI_COMM_WORLD done' + do i=1,5 + print *, 'Status source=',status(MPI_SOURCE,i), & + ' tag=',status(MPI_TAG,i) + end do - do i=1,5 - print *, 'Status source=',status(MPI_SOURCE,i), & - ' tag=',status(MPI_TAG,i) - end do + call mpi_waitall(5,sreq2,status,ier) + print *,'sends on comm2 done' - call mpi_waitall(5,sreq2,status,ier) - print *,'sends on comm2 done' + call mpi_waitall(5,rreq2,status,ier) + print *,'recvs on comm2 done' - call mpi_waitall(5,rreq2,status,ier) - print *,'recvs on comm2 done' + do i=1,5 + print *, 'Status source=',status(MPI_SOURCE,i), & + ' tag=',status(MPI_TAG,i) + end do - do i=1,5 - print *, 'Status source=',status(MPI_SOURCE,i), & - ' tag=',status(MPI_TAG,i) - end do + ! pack/unpack -! pack/unpack + position=0 + do i=1,5 + temp=100+i + call mpi_pack(temp,1,MPI_INTEGER,sbuf,20,position,MPI_COMM_WORLD,ier) + end do - position=0 - do i=1,5 - temp=100+i - call mpi_pack(temp,1,MPI_INTEGER,sbuf,20,position,MPI_COMM_WORLD,ier) - end do + call mpi_isend(sbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,sreq(1),ier) + call mpi_irecv(rbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,rreq(1),ier) + call mpi_waitall(1,rreq,status,ier) - call mpi_isend(sbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,sreq(1),ier) - call mpi_irecv(rbuf,position,MPI_PACKED,0,0,MPI_COMM_WORLD,rreq(1),ier) - call mpi_waitall(1,rreq,status,ier) + print *,"Pack/send/unpack:" - print *,"Pack/send/unpack:" + position=0 + do i=1,5 + call mpi_unpack( rbuf,20,position,temp,1,MPI_INTEGER, & + MPI_COMM_WORLD) + print *,temp + end do + + do i=1,5 + if (rbuf(i) .ne. sbuf(i)) then + errcount = errcount + 1 + print *,"Error for pack/send/unpack" + print *,"found ",rbuf(i)," should be ",sbuf(i) + end if + end do + ! - position=0 - do i=1,5 - call mpi_unpack( rbuf,20,position,temp,1,MPI_INTEGER, & - MPI_COMM_WORLD) - print *,temp - end do - do i=1,5 - if (rbuf(i) .ne. sbuf(i)) then - errcount = errcount + 1 - print *,"Error for pack/send/unpack" - print *,"found ",rbuf(i)," should be ",sbuf(i) - end if - end do -! + call mpi_finalize(ier) + do i=1,5 + print *, 'Time=',mpi_wtime() + call sleep(1) + end do - call mpi_finalize(ier) - - do i=1,5 - print *, 'Time=',mpi_wtime() - call sleep(1) - end do - - if (errcount .gt. 0) then - print *,errcount," errors" - else - print *,"No errors" - end if - - end - + if (errcount .gt. 0) then + print *,errcount," errors" + else + print *,"No errors" + end if + +end program test diff --git a/src/externals/mct/mpi-serial/type.c b/src/externals/mct/mpi-serial/type.c index 22e3d305b38..ac3b8400e63 100644 --- a/src/externals/mct/mpi-serial/type.c +++ b/src/externals/mct/mpi-serial/type.c @@ -448,6 +448,23 @@ int MPI_Type_hvector(int count, int blocklen, MPI_Aint stride, return Type_hvector(count, blocklen, stride, old_ptr, new_ptr); } +FC_FUNC( mpi_type_create_hvector, MPI_TYPE_CREATE_HVECTOR ) + (int * count, long * blocklen, long * stride, + int * oldtype, int * newtype, int * ierr) +{ + *ierr = MPI_Type_create_hvector(*count, *blocklen, *stride, *oldtype, newtype); +} + +int MPI_Type_create_hvector(int count, int blocklen, MPI_Aint stride, + MPI_Datatype oldtype, MPI_Datatype * newtype) +{ + Datatype old_ptr = *(Datatype*) mpi_handle_to_datatype(oldtype); + Datatype * new_ptr; + + mpi_alloc_handle(newtype, (void**) &new_ptr); + return Type_hvector(count, blocklen, stride, old_ptr, new_ptr); +} + int Type_hvector(int count, int blocklen, MPI_Aint stride, Datatype oldtype, Datatype *newtype) @@ -826,4 +843,3 @@ int Pprint_typemap(Datatype type) return MPI_SUCCESS; } #endif //TEST_INTERNAL -