From 85128cc863d3ffeaf0163a65ddc3fbc13224549a Mon Sep 17 00:00:00 2001 From: Steve Goldhaber Date: Mon, 4 Sep 2017 13:35:25 -0600 Subject: [PATCH] Squashed 'mpi-serial/' changes from d757b65..b1b0bfd b1b0bfd Merge pull request #10 from gold2718/add_version e2804c7 Fixed typo in print statement 1aa326e Added MPI_VERSION, MPI_SUBVERSION, and MPI_Get_Version 99df320 Merge branch `jedwards4b/jpe_add_mpi_type_create_hvector` (PR #2) 6d736e2 Merge branch 'gold2718/cleandoc' (PR #7) 94e39f8 Removed obsolete NOTES file c696f25 Merge branch gold2718/add_tag_ub (PR #6) 481ffe3 Removed tabs from mpif.h and added new constant, MPI_TAG_UB. Added newer interfaces to README Removed redundant interface, mpi_op_create from collective.c 0a44baa add mpi_type_create_hvector 1ef3693 Merge branch MCSclimate/rljacob/remove-eolwhite (PR #1) 8c02275 Remove all whitespace from end-of-line git-subtree-dir: mpi-serial git-subtree-split: b1b0bfd4d4b71abe071abbe6ccf01ece98d93ab0 --- Makefile | 2 +- NOTES | 46 ---- README | 42 +++- cart.c | 8 +- collective.c | 55 ++--- comm.c | 6 +- copy.c | 10 +- error.c | 2 +- group.c | 12 +- handles.c | 12 +- ic_merge.c | 2 +- list.c | 30 +-- list.h | 10 +- listP.h | 2 +- listops.h | 2 +- m4/ax_fc_version.m4 | 4 +- mpi.c | 22 +- mpi.h | 54 ++--- mpiP.h | 2 +- mpif.h | 456 +++++++++++++++++++-------------------- op.c | 2 +- pack.c | 16 +- probe.c | 2 +- recv.c | 2 +- req.c | 6 +- send.c | 2 +- tests/ctest.c | 50 ++--- tests/ctest_old.c | 6 +- tests/ftest.F90 | 77 ++++--- tests/ftest_internal.F90 | 26 +-- type.c | 121 ++++++----- type.h | 14 +- type_const.c | 34 +-- 33 files changed, 584 insertions(+), 553 deletions(-) delete mode 100644 NOTES diff --git a/Makefile b/Makefile index 464526e3..0b1ca1db 100644 --- a/Makefile +++ b/Makefile @@ -64,7 +64,7 @@ LIB = lib$(MODULE).a #RULES .SUFFIXES: -.SUFFIXES: .F90 .c .o +.SUFFIXES: .F90 .c .o .c.o: $(CC) -c $(INCPATH) $(DEFS) $(CPPDEFS) $(CFLAGS) $< diff --git a/NOTES b/NOTES deleted file mode 100644 index 92d87231..00000000 --- a/NOTES +++ /dev/null @@ -1,46 +0,0 @@ - -cart.c - new file, cleaned -collective.c - done -comm.c - done -copy.c - new file, cleaned -getcount.c - new file, cleaned -group.c - copied over git updates -handles.c - nothing to merge, svn updates OK -list.c - svn OK -mpi.c - merged git in -mpi.h - merged git but need to fix some types -fort.F90 - merged git in -mpif.master.h -> mpif.h NOTE: need to add types in type.h,c -Makefile - had to uncomment some things to get mpif.h to build -op.c - new file -pack.c - format more like git, has new code -probe.c - new file -recv.c - done -req.c - merged in git -send.c - merged in git - -time.c - no changes -type.c - new file -type_const.c - new file - - - -*** NOTES - -*** need to look at Request struct, add a type - so that send.c and recv.c can use distinct send and recv types - -*** need to add types in mpi.h and mpif.master.h to type.{c,h} - - -*** need to look at config and how it sets _RSIZE_ and _DSIZE_ - - previously: MCT's configure set env FORT_SIZE - choose mpif.h from mpif.$FORT_SIZE.h - - now: FORT_SIZE ignored - configures sets FSIZE_REAL and FSIZE_DPRECISION based on mpi-serial's configure (default 4/8) - does not need mpif.master.h template -> mpif.$FORT_SIZE.h - - so... did i clobber good value of mpif.h ? - diff --git a/README b/README index 20e37760..aaa72850 100644 --- a/README +++ b/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/cart.c b/cart.c index 3f3f94c0..a53ef481 100644 --- a/cart.c +++ b/cart.c @@ -1,9 +1,9 @@ #include "mpiP.h" -/* +/* * MPI_Cart_create * - * create a new communicator, + * create a new communicator, */ @@ -53,7 +53,7 @@ FC_FUNC( mpi_cart_get , MPI_CART_GET ) int MPI_Cart_get(MPI_Comm comm, int maxdims, int *dims, - int *periods, int *coords) + int *periods, int *coords) { int i; for (i=0;icount * src_count < dest_type->count * dest_count) @@ -71,7 +71,7 @@ int Pcopy_data2(void *source, int src_count, Datatype src_type, { #ifdef TYPE_CHECKING - if ( src_type->pairs[i % src_type->count].type != + if ( src_type->pairs[i % src_type->count].type != dest_type->pairs[i % dest_type->count].type) { printf("copy_data: Types don't match.\n"); @@ -80,7 +80,7 @@ int Pcopy_data2(void *source, int src_count, Datatype src_type, #endif soffset = src_type->pairs[i % src_type->count].disp + ((i / src_type->count) * src_extent); - doffset = dest_type->pairs[i % dest_type->count].disp + ((i / dest_type->count) * dest_extent); + doffset = dest_type->pairs[i % dest_type->count].disp + ((i / dest_type->count) * dest_extent); memcpy(dest+doffset, source+soffset, Simpletype_length(dest_type->pairs[i % dest_type->count].type)); } diff --git a/error.c b/error.c index 8c29663a..d26cfd16 100644 --- a/error.c +++ b/error.c @@ -3,7 +3,7 @@ /* * Error handling code - * Just a stub for now to support the MPI interface without actually + * Just a stub for now to support the MPI interface without actually * doing anything */ diff --git a/group.c b/group.c index 88726651..cec4879f 100644 --- a/group.c +++ b/group.c @@ -51,7 +51,7 @@ FC_FUNC( mpi_group_range_incl, MPI_GROUP_RANGE_INCL ) { *ierror= MPI_Group_range_incl(*group, *n, ranges, newgroup); } - + int MPI_Group_range_incl(MPI_Group group, int n, int ranges[][3], MPI_Group *newgroup) @@ -100,7 +100,7 @@ int MPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup) fprintf(stderr,"MPI_Group_union: null group passed in\n"); abort(); } - + if (group1==MPI_GROUP_ONE || group2==MPI_GROUP_ONE) *newgroup=MPI_GROUP_ONE; else @@ -131,7 +131,7 @@ int MPI_Group_intersection(MPI_Group group1, MPI_Group group2, fprintf(stderr,"MPI_Group_intersection: null group passed in\n"); abort(); } - + if (group1==MPI_GROUP_ONE && group2==MPI_GROUP_ONE) *newgroup=MPI_GROUP_ONE; else @@ -163,7 +163,7 @@ int MPI_Group_difference(MPI_Group group1, MPI_Group group2, fprintf(stderr,"MPI_Group_intersection: null group passed in\n"); abort(); } - + if (group1==MPI_GROUP_EMPTY || group2==MPI_GROUP_ONE) *newgroup=MPI_GROUP_EMPTY; else @@ -222,7 +222,7 @@ int MPI_Group_translate_ranks(MPI_Group group1, int n, int *ranks1, { fprintf(stderr,"MPI_Group_translate_ranks: empty input group\n"); abort(); - } + } for (i=0; i simplified and store item directly in the struct * rather than as pointer to separately allocated object. - * + * * CAVEAT: - * as in mpich-1, storage will grow as needed and will + * as in mpich-1, storage will grow as needed and will * remain at the high water mark since it is likely that * the user code will repeat the use. * - */ + */ typedef struct _Handleitem @@ -87,7 +87,7 @@ void *mpi_malloc(int size) fprintf(stderr,"mpi_malloc: failed to allocate %d bytes\n",size); abort(); } - + return(ret); } @@ -151,7 +151,7 @@ static void init_handles(void) for (i=1; i #include "listops.h" #include "listP.h" - + /* * list management code * @@ -41,7 +41,7 @@ static pListitem AP_listitem_malloc(void) perror("AP_listitem_malloc: malloc failure"); abort(); } - + return(item); } @@ -90,7 +90,7 @@ pListitem AP_listitem_prev(pListitem listitem) { return(listitem->prev); } - + pListitem AP_listitem_next(pListitem listitem) @@ -115,7 +115,7 @@ void *AP_listitem_data(pListitem listitem) /* * AP_list_new(void) - * + * * allocate an empty list return a pointer to it * */ @@ -175,7 +175,7 @@ void AP_list_free(pList list) list->count,count); abort(); } - + headcount--; free(list); } @@ -186,7 +186,7 @@ void AP_list_free(pList list) * AP_list_size(list) * * return the number of items in an ilist - * + * */ int AP_list_size(pList list) @@ -258,7 +258,7 @@ pListitem AP_list_append(pList list, void *data) list->tail=new; (list->count)++; - + return(new); } @@ -307,7 +307,7 @@ void AP_list_delete_item(pList list, pListitem item) item->prev->next = item->next; /* set pointer of following listitem */ - + if (item == list->tail) list->tail = item->prev; else @@ -315,7 +315,7 @@ void AP_list_delete_item(pList list, pListitem item) AP_listitem_free(item); (list->count)--; -} +} @@ -352,7 +352,7 @@ int AP_list_tail(pList list, void **data) } - + /* @@ -486,7 +486,7 @@ int AP_list_next(pList list, void **data, void **temp) } else /* First item */ cur=list->head; - + if (cur) { *temp=(void *)cur; @@ -504,7 +504,7 @@ int AP_list_next(pList list, void **data, void **temp) * between NULL in the list, and the end of the list * */ - + void *AP_list_braindead_next(pList list, void **temp) { void *item; @@ -552,11 +552,11 @@ pList AP_list_duplicate(pList list) if (prev) prev->next=NULL; - + newlist->tail=prev; newlist->count=list->count; return(newlist); -} +} @@ -677,7 +677,7 @@ int main() printf(" Got item %d",(int)(AP_listitem_data(item))); next=AP_listitem_next(item); - + if (i%2) { AP_list_delete_item(list2,item); diff --git a/list.h b/list.h index 34b03fa7..3d533fef 100644 --- a/list.h +++ b/list.h @@ -7,11 +7,11 @@ -/****************************************************** - * WARNING: This file automatically generated. * - * Do not edit by hand. * - ****************************************************** - */ +/****************************************************** + * WARNING: This file automatically generated. * + * Do not edit by hand. * + ****************************************************** + */ diff --git a/listP.h b/listP.h index 77b892dc..2fa9e859 100644 --- a/listP.h +++ b/listP.h @@ -6,7 +6,7 @@ /* - * Private data structures for the list + * Private data structures for the list * */ diff --git a/listops.h b/listops.h index 0c28e8ed..fa0ef725 100644 --- a/listops.h +++ b/listops.h @@ -17,7 +17,7 @@ typedef struct _List *pList; typedef struct _Listitem *pListitem; - + #include "list.h" #endif diff --git a/m4/ax_fc_version.m4 b/m4/ax_fc_version.m4 index fa2bf042..c7e2eaec 100644 --- a/m4/ax_fc_version.m4 +++ b/m4/ax_fc_version.m4 @@ -2,7 +2,7 @@ # ------------------------------------------------- # Link a trivial Fortran program, compiling with a version output FLAG # (which default value, $ac_cv_prog_fc_version, is computed by -# AX_FC_VERSION), and return the output in $ac_fc_version_output. +# AX_FC_VERSION), and return the output in $ac_fc_version_output. AC_DEFUN([AX_FC_VERSION_OUTPUT], [AC_REQUIRE([AC_PROG_FC])dnl AC_LANG_PUSH(Fortran)dnl @@ -10,7 +10,7 @@ AC_LANG_PUSH(Fortran)dnl AC_LANG_CONFTEST([AC_LANG_PROGRAM([])]) # Compile and link our simple test program by passing a flag (argument -# 1 to this macro) to the Fortran 90 compiler in order to get "version" output +# 1 to this macro) to the Fortran 90 compiler in order to get "version" output ac_save_FCFLAGS=$FCFLAGS FCFLAGS="$FCFLAGS m4_default([$1], [$ac_cv_prog_fc_version])" (eval echo $as_me:__oline__: \"$ac_link\") >&AS_MESSAGE_LOG_FD diff --git a/mpi.c b/mpi.c index aaa8524f..0353f477 100644 --- a/mpi.c +++ b/mpi.c @@ -35,9 +35,9 @@ FC_FUNC( mpi_init_fort , MPI_INIT_FORT) int *f_MPI_COMM_NULL, int *f_MPI_REQUEST_NULL, int *f_MPI_GROUP_NULL, int *f_MPI_GROUP_EMPTY, int *f_MPI_UNDEFINED, - int *f_MPI_MAX_ERROR_STRING, - int *f_MPI_MAX_PROCESSOR_NAME, - int *f_MPI_STATUS_SIZE, + int *f_MPI_MAX_ERROR_STRING, + int *f_MPI_MAX_PROCESSOR_NAME, + int *f_MPI_STATUS_SIZE, int *f_MPI_SOURCE, int *f_MPI_TAG, int *f_MPI_ERROR, int *f_status, int *fsource, int *ftag, int *ferror, @@ -156,7 +156,7 @@ FC_FUNC( mpi_init_fort , MPI_INIT_FORT) abort(); } -int MPI_Init(int *argc, char **argv[]) +int MPI_Init(int *argc, char **argv[]) { MPI_Comm my_comm_world; @@ -323,7 +323,21 @@ int MPI_Get_library_version(char *version, int *resultlen) return(MPI_SUCCESS); } +/**********/ +void FC_FUNC( mpi_get_version, MPI_GET_VERSION )(int *mpi_vers, int *mpi_subvers, int *ierror) +{ + MPI_Get_Version(mpi_vers, mpi_subvers); + + *ierror=MPI_SUCCESS; +} + +int MPI_Get_Version(int *mpi_vers, int *mpi_subvers) +{ + *mpi_vers = 1; + *mpi_subvers = 0; + return (MPI_SUCCESS); +} /**********/ diff --git a/mpi.h b/mpi.h index af5f7b2a..9183bf89 100644 --- a/mpi.h +++ b/mpi.h @@ -1,4 +1,3 @@ - #ifndef _MPI_H_ #define _MPI_H_ @@ -15,7 +14,7 @@ typedef int MPI_Request; typedef int MPI_Group; /* MPI_GROUP_EMPTY and MPI_GROUP_NULL must not conflict with MPI_GROUP_ONE */ -#define MPI_GROUP_EMPTY (-1) +#define MPI_GROUP_EMPTY (-1) #define MPI_GROUP_NULL (0) @@ -109,12 +108,12 @@ typedef int MPI_Datatype; //Reduction function types -#define MPI_FLOAT_INT (-26) -#define MPI_DOUBLE_INT (-27) +#define MPI_FLOAT_INT (-26) +#define MPI_DOUBLE_INT (-27) #define MPI_LONG_INT (-28) #define MPI_2INT (-29) -#define MPI_SHORT_INT (-30) -#define MPI_LONG_DOUBLE_INT (-31) +#define MPI_SHORT_INT (-30) +#define MPI_LONG_DOUBLE_INT (-31) /* Fortran size-specific types */ @@ -207,7 +206,7 @@ typedef int MPI_Errhandler; typedef int MPI_Op; typedef void MPI_User_function( void *invec, void *inoutvec, int *len, - MPI_Datatype *datatype); + MPI_Datatype *datatype); #define MPI_OP_NULL (0) @@ -247,12 +246,12 @@ typedef int MPI_Info; /* handle */ * Note: if you need to regenerate the prototypes below, * you can use 'protify.awk' and paste the output here. * - */ + */ extern int MPI_Intercomm_create(MPI_Comm local_comm, int local_leader, MPI_Comm peer_comm, int remote_leader, - int tag, MPI_Comm *newintercomm); + 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, @@ -269,7 +268,7 @@ extern int MPI_Bcast(void* buffer, int count, MPI_Datatype datatype, extern int MPI_Gather(void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); -extern int MPI_Gatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype, +extern int MPI_Gatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf, int *recvcounts, int *displs, MPI_Datatype recvtype, int root, MPI_Comm comm); extern int MPI_Allgather(void* sendbuf, int sendcount, MPI_Datatype sendtype, @@ -281,16 +280,16 @@ extern int MPI_Allgatherv(void* sendbuf, int sendcount, MPI_Datatype sendtype, extern int MPI_Scatter( void* sendbuf, int sendcount, MPI_Datatype sendtype, void* recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); -extern int MPI_Scatterv(void* sendbuf, int *sendcounts, int *displs, - MPI_Datatype sendtype, void* recvbuf, int recvcount, +extern int MPI_Scatterv(void* sendbuf, int *sendcounts, int *displs, + MPI_Datatype sendtype, void* recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm); -extern int MPI_Reduce(void* sendbuf, void* recvbuf, int count, +extern int MPI_Reduce(void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm); -extern int MPI_Reduce_scatter(void* sendbuf, void* recvbuf, int *recvcounts, +extern int MPI_Reduce_scatter(void* sendbuf, void* recvbuf, int *recvcounts, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); -extern int MPI_Allreduce(void* sendbuf, void* recvbuf, int count, +extern int MPI_Allreduce(void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); -extern int MPI_Scan( void* sendbuf, void* recvbuf, int count, +extern int MPI_Scan( void* sendbuf, void* recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm); extern int MPI_Alltoall(void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, @@ -323,12 +322,12 @@ extern int MPI_Comm_group(MPI_Comm comm, MPI_Group *group); extern MPI_Comm MPI_Comm_f2c(MPI_Fint comm); extern MPI_Fint MPI_Comm_c2f(MPI_Comm comm); extern int MPI_Group_incl(MPI_Group group, int n, int *ranks, MPI_Group *newgroup); -extern int MPI_Group_range_incl(MPI_Group group, int n, int ranges[][3], +extern int MPI_Group_range_incl(MPI_Group group, int n, int ranges[][3], MPI_Group *newgroup); extern int MPI_Group_union(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup); extern int MPI_Group_intersection(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup); -extern int MPI_Group_difference(MPI_Group group1, MPI_Group group2, +extern int MPI_Group_difference(MPI_Group group1, MPI_Group group2, MPI_Group *newgroup); extern int MPI_Group_free(MPI_Group *group); extern int MPI_Group_translate_ranks(MPI_Group group1, int n, int *ranks1, @@ -368,10 +367,10 @@ extern int MPI_Waitall(int count, MPI_Request *array_of_requests, MPI_Status *array_of_statuses); extern MPI_Request MPI_Request_f2c(MPI_Fint request); extern MPI_Fint MPI_Request_c2f(MPI_Request request); -extern int MPI_Testsome(int incount, MPI_Request *array_of_requests, - int *outcount, int *array_of_indices, +extern int MPI_Testsome(int incount, MPI_Request *array_of_requests, + int *outcount, int *array_of_indices, MPI_Status *array_of_statuses); -extern int MPI_Waitsome(int incount, MPI_Request *array_of_requests, +extern int MPI_Waitsome(int incount, MPI_Request *array_of_requests, int *outcount, int *array_of_indices, MPI_Status *array_of_statuses); extern int MPI_Request_free(MPI_Request * req); @@ -392,7 +391,7 @@ extern int MPI_Sendrecv(void* sendbuf, int sendcount, MPI_Datatype sendtype, MPI_Comm comm, MPI_Status *status); extern int MPI_Probe(int source, int tag, MPI_Comm comm, MPI_Status *status); -extern int MPI_Iprobe(int source, int tag, MPI_Comm comm, +extern int MPI_Iprobe(int source, int tag, MPI_Comm comm, int *flag, MPI_Status *status); extern int MPI_Pack_size(int incount, MPI_Datatype type, MPI_Comm comm, MPI_Aint * size); @@ -408,18 +407,21 @@ extern int MPI_Type_contiguous(int count, MPI_Datatype oldtype, MPI_Datatype *ne extern int MPI_Type_vector(int count, int blocklen, int stride, MPI_Datatype oldtype, MPI_Datatype *newtype); -extern int MPI_Type_hvector(int count, int blocklen, MPI_Aint stride, +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); -extern int MPI_Type_create_indexed_block(int count, int blocklen, int *displacements, +extern int MPI_Type_create_indexed_block(int count, int blocklen, int *displacements, MPI_Datatype oldtype, MPI_Datatype *newtype); -extern int MPI_Type_hindexed(int count, int *blocklens, MPI_Aint *displacements, +extern int MPI_Type_hindexed(int count, int *blocklens, MPI_Aint *displacements, MPI_Datatype oldtype, MPI_Datatype *newtype); extern int MPI_Type_size(MPI_Datatype type, int * size); -extern int MPI_Type_struct(int count, int *blocklens, MPI_Aint *displacements, +extern int MPI_Type_struct(int count, int *blocklens, MPI_Aint *displacements, MPI_Datatype *oldtypes, MPI_Datatype *newtype); extern int MPI_Type_dup(MPI_Datatype oldtype, MPI_Datatype *newtype); diff --git a/mpiP.h b/mpiP.h index 527fe7ee..290d3cf9 100644 --- a/mpiP.h +++ b/mpiP.h @@ -25,7 +25,7 @@ * If config.h is not present, default to the old * approach. */ - + #ifdef HAVE_CONFIG_H #include /* config.h should define FC_FUNC */ diff --git a/mpif.h b/mpif.h index 52590d57..678ad9e9 100644 --- a/mpif.h +++ b/mpif.h @@ -1,337 +1,335 @@ -!!! -!!! 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_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_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_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_IGNORE(MPI_STATUS_SIZE) - INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1) - COMMON /MPISERIAL/ MPI_STATUS_IGNORE - COMMON /MPISERIAL/ MPI_STATUSES_IGNORE + 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 -! -! MPI_IN_PLACE -! + ! + ! MPI_IN_PLACE + ! - INTEGER MPI_IN_PLACE - COMMON /MPISERIAL/ MPI_IN_PLACE + INTEGER MPI_IN_PLACE + COMMON /MPISERIAL/ MPI_IN_PLACE - SAVE /MPISERIAL/ ! Technically needed in case goes out of scope + 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_DATATYPE_NULL + PARAMETER (MPI_DATATYPE_NULL=0) - INTEGER MPI_BYTE - PARAMETER (MPI_BYTE=-12) + INTEGER MPI_BYTE + PARAMETER (MPI_BYTE=-12) - INTEGER MPI_PACKED - PARAMETER (MPI_PACKED=-13) + INTEGER MPI_PACKED + PARAMETER (MPI_PACKED=-13) - INTEGER MPI_LB - PARAMETER (MPI_LB=-14) + INTEGER MPI_LB + PARAMETER (MPI_LB=-14) - INTEGER MPI_UB - PARAMETER (MPI_UB=-15) + INTEGER MPI_UB + PARAMETER (MPI_UB=-15) - INTEGER MPI_INTEGER - PARAMETER (MPI_INTEGER=-16) - - 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) - -! -! MPI_Op values -! -! (All are handled as no-op so no value is necessary; but provide one -! anyway just in case.) -! + integer MPI_UNSIGNED_LONG_LONG + parameter (MPI_UNSIGNED_LONG_LONG= -44) - 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) + + ! + ! MPI Version + ! + INTEGER MPI_VERSION + PARAMETER (MPI_VERSION=1) + INTEGER MPI_SUBVERSION + PARAMETER (MPI_SUBVERSION=0) diff --git a/op.c b/op.c index 3050b9db..64efbc10 100644 --- a/op.c +++ b/op.c @@ -10,7 +10,7 @@ FC_FUNC(mpi_op_create, MPI_OP_CREATE)(MPI_User_function *func, int * commute, in *ierr = MPI_Op_create(func, *commute, op); } -int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op) +int MPI_Op_create(MPI_User_function *function, int commute, MPI_Op *op) { *op = 0; return MPI_SUCCESS; diff --git a/pack.c b/pack.c index fd3e74fa..83ff8799 100644 --- a/pack.c +++ b/pack.c @@ -34,7 +34,7 @@ int MPI_Pack( void *inbuf, int incount, MPI_Datatype datatype, -int Pack(void *inbuf, int incount, Datatype type, +int Pack(void *inbuf, int incount, Datatype type, void *outbuf, int outsize, int *position, Comm * comm) { int i, j; @@ -51,19 +51,19 @@ int Pack(void *inbuf, int incount, Datatype type, exit(1); } memcpy(((char*) outbuf)+(*position), inbuf+type->pairs[j].disp + (extent*i), - Simpletype_length(type->pairs[j].type)); + Simpletype_length(type->pairs[j].type)); *position += Simpletype_length(type->pairs[j].type); } } } -FC_FUNC( mpi_pack_size, MPI_PACK_SIZE )(int * incount, int * datatype, +FC_FUNC( mpi_pack_size, MPI_PACK_SIZE )(int * incount, int * datatype, int * comm, long * size, int *ierr) { *ierr = MPI_Pack_size(*incount, *datatype, *comm, size); } -int MPI_Pack_size(int incount, MPI_Datatype datatype, +int MPI_Pack_size(int incount, MPI_Datatype datatype, MPI_Comm comm, MPI_Aint * size) { int ret; @@ -76,7 +76,7 @@ int MPI_Pack_size(int incount, MPI_Datatype datatype, } -int Pack_size(int incount, Datatype datatype, +int Pack_size(int incount, Datatype datatype, Comm * comm, MPI_Aint * size) { int i; @@ -106,7 +106,7 @@ FC_FUNC( mpi_unpack , MPI_UNPACK ) } -int MPI_Unpack(void * inbuf, int insize, int * position, void * outbuf, +int MPI_Unpack(void * inbuf, int insize, int * position, void * outbuf, int outcount, MPI_Datatype type, MPI_Comm comm) { int ret; @@ -114,7 +114,7 @@ int MPI_Unpack(void * inbuf, int insize, int * position, void * outbuf, Comm * comm_ptr = mpi_handle_to_ptr(comm); ret = Unpack(inbuf, insize, position, outbuf, outcount, type_ptr, comm_ptr); - + return ret; } @@ -129,7 +129,7 @@ int Unpack(void * inbuf, int insize, int * position, void *outbuf, for (i = 0; i < outcount; i++) { for (j = 0; j < type->count; j++) - { + { if ((*position) + Simpletype_length(type->pairs[j].type) > insize) { printf("MPI_Unpack: Data exceeds buffer size\n"); diff --git a/probe.c b/probe.c index e6e36c12..29c3c52e 100644 --- a/probe.c +++ b/probe.c @@ -7,7 +7,7 @@ static int mpi_match_send(void *r, void *tag) *((int *)tag) == ((Req *)r)->tag ); } -FC_FUNC(mpi_iprobe, MPI_IPROBE)(int * source, int * tag, int * comm, +FC_FUNC(mpi_iprobe, MPI_IPROBE)(int * source, int * tag, int * comm, int * flag, int *status, int * ierr) { *ierr = MPI_Iprobe(*source, *tag, *comm, flag, mpi_c_status(status)); diff --git a/recv.c b/recv.c index 9111bba9..d70344a3 100644 --- a/recv.c +++ b/recv.c @@ -3,7 +3,7 @@ -/* +/* * RECEIVING * */ diff --git a/req.c b/req.c index 638abe11..5cfa827f 100644 --- a/req.c +++ b/req.c @@ -217,7 +217,7 @@ FC_FUNC(mpi_testsome, MPI_TESTSOME) } int MPI_Testsome(int incount, MPI_Request *array_of_requests, int *outcount, - int *array_of_indices, MPI_Status *array_of_statuses) + int *array_of_indices, MPI_Status *array_of_statuses) { int i; int flag; @@ -236,7 +236,7 @@ int MPI_Testsome(int incount, MPI_Request *array_of_requests, int *outcount, } -/* Waitsome: checks for availability of at least one status from array of +/* Waitsome: checks for availability of at least one status from array of * requests. If no statuses are available, abort with error */ @@ -249,7 +249,7 @@ FC_FUNC(mpi_waitsome, MPI_WAITSOME) } int MPI_Waitsome(int incount, MPI_Request *array_of_requests, int *outcount, - int *array_of_indices, MPI_Status *array_of_statuses) + int *array_of_indices, MPI_Status *array_of_statuses) { MPI_Testsome(incount, array_of_requests, outcount, array_of_indices, array_of_statuses); diff --git a/send.c b/send.c index 316c54d2..9e6e7c5d 100644 --- a/send.c +++ b/send.c @@ -34,7 +34,7 @@ FC_FUNC( mpi_isend , MPI_ISEND )(void *buf, int *count, int *datatype, int MPI_Isend(void *buf, int count, MPI_Datatype datatype, - int dest, int tag, MPI_Comm comm, MPI_Request *request) + int dest, int tag, MPI_Comm comm, MPI_Request *request) { pListitem match; Comm *mycomm; diff --git a/tests/ctest.c b/tests/ctest.c index 0e3d5e5c..4a9b50ab 100644 --- a/tests/ctest.c +++ b/tests/ctest.c @@ -4,7 +4,7 @@ #ifdef HAVE_CONFIG_H #include -#endif +#endif #ifdef TEST_INTERNAL #include @@ -154,7 +154,7 @@ void test_simple_indexed() //Indexed of simple types printf("\nIndexed type of MPI_INT.\n"); - + MPI_Type_indexed(3, blens, disps, MPI_INT, &indexed_type); MPI_Type_commit(&indexed_type); @@ -184,7 +184,7 @@ void test_simple_indexed() return; } } - + //block indexed. Same as indexed except //static block length @@ -226,7 +226,7 @@ void test_simple_bindexed() errcount++; return; } -} +} //hindexed: same as indexed, but //using byte displacements based off of sizeof(int) @@ -322,7 +322,7 @@ void test_simple_hindexed() MPI_Type_struct(5, blocklengths, boffsets, types, &newtype2); print_typemap(newtype2); - + //struct type: 2 int, 1 float printf("\nSimple struct for use: 2 int, 1 float\n"); blocklengths[0] = 2; @@ -370,7 +370,7 @@ void test_simple_hindexed() types[1] = indexed_type; types[2] = MPI_CHAR; types[3] = newtype2; - + MPI_Type_struct(4, blocklengths, boffsets, types, &struct_type); print_typemap(struct_type); } @@ -430,7 +430,7 @@ void test_complex_struct() MPI_Datatype types[3] = {MPI_LONG, MPI_INT, MPI_CHAR}; MPI_Datatype newtype; - + printf("\nSimple struct to create complex struct\n"); MPI_Type_struct(3, blens, disps, types, &newtype); MPI_Type_commit(&newtype); @@ -449,7 +449,7 @@ void test_complex_struct() return; } MPI_Datatype newtype2; - + blens[0] = 1; blens[1] = 1; blens[2] = 1; @@ -486,7 +486,7 @@ void test_complex_struct() void test_indexed_struct() { int i; - + //simple struct vars int s_blens[4] = {1,1,1,2}; MPI_Aint s_disps[4]; @@ -504,7 +504,7 @@ void test_indexed_struct() struct_t send[10]; struct_t recv[10]; - + //initialize the structs for (i = 0; i < 10; i++) { @@ -519,7 +519,7 @@ void test_indexed_struct() recv[i].d=0; recv[i].e=0; } - + //set the displacements by using address differences sadd = (char *)&send[0]; s_disps[0] = (char*)&(send[0].a) - sadd; @@ -536,7 +536,7 @@ void test_indexed_struct() #endif //now, create an indexed type of this struct - MPI_Type_indexed(3, i_blens, i_disps, + MPI_Type_indexed(3, i_blens, i_disps, s_struct, &i_struct_indexed); MPI_Type_commit(&i_struct_indexed); @@ -563,9 +563,9 @@ void test_indexed_struct() } //to make things really interesting, let's send as the - //indexed type, and receive instead as _count_ + //indexed type, and receive instead as _count_ //consecutive struct types -#ifdef TEST_INTERNAL +#ifdef TEST_INTERNAL copy_data2(send, 1, i_struct_indexed, recv, 6, s_struct); #else MPI_Gather(&send, 1, i_struct_indexed, &recv, @@ -573,7 +573,7 @@ void test_indexed_struct() // MPI_Isend(&send, 1, i_struct_indexed, 0, 0, MPI_COMM_WORLD, &req); // MPI_Irecv(&recv, 6, s_struct, 0, 0, MPI_COMM_WORLD, &req); - + #endif for (i = 0; i < 6; i++) @@ -604,14 +604,14 @@ void test_multiple() int b[5] = {0, 0, 0, 0, 0}; - + MPI_Datatype contig5int; printf("\nSend contiguous of 5 MPI_INT, receive 5 x MPI_INT\n"); MPI_Type_contiguous(5, MPI_INT, &contig5int); MPI_Type_commit(&contig5int); -#ifdef TEST_INTERNAL +#ifdef TEST_INTERNAL copy_data2(&a, 5, MPI_INT, &b, 1, contig5int); #else MPI_Isend(&a, 5, MPI_INT, 0, 0, MPI_COMM_WORLD, &req); @@ -785,7 +785,7 @@ void test_packed_complex() errcount++; \ printf(">>>FAILED: test_collectives: %s\n", op); \ } \ -} +} void test_collectives() { @@ -797,7 +797,7 @@ void test_collectives() int disp = 0; int sendcount = 1, recvcount = 1; - + int blens[3] = {2,1,1}; MPI_Datatype types[3] = {MPI_INT, MPI_DOUBLE, MPI_LONG}; @@ -837,7 +837,7 @@ void test_collectives() MPI_Scatterv(&s1, &sendcount, &disp, struct_type, &s2, recvcount, struct_type, 0, MPI_COMM_WORLD); test_eq(s1,s2,"MPI_Scatterv"); - + s2.a=0; s2.b=0; s2.c=0.00; s2.d=0; MPI_Reduce(&s1, &s2, sendcount, struct_type, MPI_MAX, 0, MPI_COMM_WORLD); test_eq(s1, s2, "MPI_Reduce"); @@ -918,7 +918,7 @@ void structtests() printf("Done.\n"); fflush(stdout); print_typemap(type); - copy_data(&a, &b, type); + copy_data(&a, &b, type); printf("b = %d\n", a[4]); } */ @@ -929,10 +929,10 @@ int main(int argc, char ** argv) int vlen; MPI_Init(&argc, &argv); - + MPI_Get_library_version(version,&vlen); printf("MPI version=\"%s\" (len=%d)\n",version,vlen); - + // structtests(); // indexed_test(); // struct_test(); @@ -949,7 +949,7 @@ int main(int argc, char ** argv) test_simple_hindexed(); test_simple_struct(); test_complex_struct(); - test_indexed_struct(); + test_indexed_struct(); test_multiple(); test_multiple_struct(); test_packed(); @@ -961,7 +961,7 @@ int main(int argc, char ** argv) printf("Found %d errors\n", errcount); else printf(">>>PASSED ALL TESTS. No errors. <<<\n"); - + return(errcount); } diff --git a/tests/ctest_old.c b/tests/ctest_old.c index 2fcdf8e3..e4ff3cb8 100644 --- a/tests/ctest_old.c +++ b/tests/ctest_old.c @@ -56,7 +56,7 @@ main(int argc, char *argv[]) MPI_Irecv(&rbuf[2*i],1,MPI_2INT, 0,tag,MPI_COMM_WORLD,&rreq[i]); - + } @@ -134,10 +134,10 @@ main(int argc, char *argv[]) for (i=0; i<5; i++) { temp=100+i; - MPI_Pack(&temp, 1, MPI_INT, sbuf, 20, &position, MPI_COMM_WORLD); + MPI_Pack(&temp, 1, MPI_INT, sbuf, 20, &position, MPI_COMM_WORLD); } - MPI_Isend( sbuf, position, MPI_PACKED, 0, 0, MPI_COMM_WORLD,&sreq[0]); + MPI_Isend( sbuf, position, MPI_PACKED, 0, 0, MPI_COMM_WORLD,&sreq[0]); MPI_Irecv( rbuf, position, MPI_PACKED, 0, 0, MPI_COMM_WORLD, &rreq[0] ); MPI_Waitall(1,rreq,status); diff --git a/tests/ftest.F90 b/tests/ftest.F90 index f07f5b5a..ef8681a3 100644 --- a/tests/ftest.F90 +++ b/tests/ftest.F90 @@ -7,8 +7,8 @@ program test implicit none integer ierr integer ec - character*(MPI_MAX_LIBRARY_VERSION_STRING) version - integer vlen + character*(MPI_MAX_LIBRARY_VERSION_STRING) version + integer vlen ec = 0 #ifdef TEST_INTERNAL @@ -17,8 +17,8 @@ program test call mpi_init(ierr) - call MPI_GET_LIBRARY_VERSION(version,vlen,ierr) - print *,"MPI Version '",version,"' len=",vlen + call MPI_GET_LIBRARY_VERSION(version,vlen,ierr) + print *,"MPI Version '",version,"' len=",vlen call test_contiguous(ec) call test_vector(ec) @@ -31,6 +31,7 @@ program test call test_multiple(ec) call test_multiple_indexed(ec) call test_collectives(ec) + call test_mpi_version(ec) call mpi_finalize(ierr) if (ec .eq. 0) then @@ -40,7 +41,7 @@ program test end if stop end - + !!!!!!!!!!!!!!!!!!! ! Contiguous type. Simplest example. Strings 5 ! integers together and tests their equality after @@ -82,12 +83,12 @@ subroutine test_contiguous(ec) end !!!!!!!!!!!!!!!!!!!!!!!! -! Vector type. collect a series of indices with +! Vector type. collect a series of indices with ! set stride from an array. !!!!!!!!!!!!!!!!!!!!!!!! subroutine test_vector(ec) - use mpi + use mpi integer ec integer ierr integer datatype @@ -123,7 +124,7 @@ subroutine test_vector(ec) !!!!!!!!!!!!!!!!!!!!! ! Byte-addressed vector. ! values calculated with mpi_type_extent(), -! so basically we are doing the work here in the +! so basically we are doing the work here in the ! test program instead of in the library !!!!!!!!!!!!!!!!!!!!! @@ -159,7 +160,7 @@ subroutine test_simple_hvector(ec) if (a(index_test(i)) .ne. (b(index_test(i)))) then print *, ">>>FAILED: test_simple_hvector" ec = ec+1 - return + return end if end do end subroutine @@ -229,7 +230,7 @@ subroutine test_simple_bindexed(ec) data index_test/1,2,5,6,8,9/ print *, "Block indexed type" - call mpi_type_create_indexed_block(3,2,disps,mpi_integer, & + call mpi_type_create_indexed_block(3,2,disps,mpi_integer, & indexed_type, ierr) call mpi_type_commit(indexed_type, ierr) #ifdef TEST_INTERNAL @@ -334,7 +335,7 @@ subroutine test_complex_indexed(ec) call mpi_type_indexed(3,blens,disps, MPI_DOUBLE_PRECISION, & indexed_type, ierr) call mpi_type_commit(indexed_type, ierr) - + data cblens/1, 2/ data cdisps/1, 4/ call mpi_type_indexed(2,cblens,cdisps,indexed_type, & @@ -346,10 +347,10 @@ subroutine test_complex_indexed(ec) call mpi_isend(a,1,complex_indexed,0,0,mpi_comm_world,req,ierr) call mpi_irecv(b,1,complex_indexed,mpi_any_source,mpi_any_tag,& mpi_comm_world, req, ierr) -#endif +#endif do i=1,3 do j=1,8 - if (a(index_test(j)+12*cindex_test(i)) .ne. & + if (a(index_test(j)+12*cindex_test(i)) .ne. & b(index_test(j)+12*cindex_test(i))) then print *, ">>>FAILED: test_complex_indexed" print *, "index ",index_test(j)+12*cindex_test(i) @@ -362,7 +363,7 @@ subroutine test_complex_indexed(ec) call mpi_type_free(complex_indexed, ierr) call mpi_type_free(indexed_type, ierr) - end subroutine + end subroutine !!!!!!!!!!!!!!!!!!!!!!!!!!!! ! test_packed() ! Creates a few variable pairs, assigns the first @@ -382,7 +383,7 @@ subroutine test_packed(ec) integer(kind=mpi_address_kind) disps(3) integer pos integer req - + x = 10 f = 14.333 c = (100, 20) @@ -390,8 +391,8 @@ subroutine test_packed(ec) pos = 0 data blens/1,2,1/, disps/0,4,8/ - - print *, "Packed type " + + print *, "Packed type " call mpi_pack(x, 1, mpi_integer, buf, 100, pos, 0, ierr) call mpi_pack(f, 1, mpi_real, buf, 100, pos, 0, ierr) @@ -422,7 +423,7 @@ subroutine test_packed(ec) end if end subroutine - + subroutine test_multiple(ec) use mpi integer ec @@ -450,7 +451,7 @@ subroutine test_multiple(ec) do i=1,10 if (a(i) .ne. b(i)) then print *, ">>>FAILED: test_multiple" - ec = ec+1 + ec = ec+1 return end if end do @@ -502,7 +503,7 @@ subroutine test_multiple_indexed(ec) print *, ">>>FAILED: test_multiple_indexed" print *, " Found:",a(index_test(j)+13*i) print *, " Expected:",b(index_test(j)+13*i) - ec = ec+1 + ec = ec+1 ! return end if end do @@ -521,7 +522,7 @@ subroutine test_collectives(ec) integer ierr integer scount integer rcount - integer disp + integer disp integer index_test(7) data scount/1/rcount/1/disp/0/ @@ -669,12 +670,40 @@ subroutine test_collectives(ec) print *, "Testing mpi_scan" call mpi_scan(a, b, scount, itype, mpi_max, & mpi_comm_world, ierr) - + do i=1,7 if (a(index_test(i)) .ne. b(index_test(i))) then print *, "mpi_scan failed" ec=ec+1 end if end do - end subroutine - + end subroutine + +!!!!!!!!!!!!!!!!!!!!!!!! +! Test MPI_VERSION +!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine test_mpi_version(ec) + use mpi + integer ec + integer ierr + integer mpiv + integer mpisv + + print *, "Testing MPI_Get_Version" + + call mpi_get_version(mpiv, mpisv, ierr) + if (ierr /= MPI_SUCCESS) then + print *, "MPI_get_VERSION ierr not zero (",ierr,")" + ec = ec + 1 + else + if (mpiv /= MPI_VERSION) then + print *, "MPI_VERSION mismatch, should be ",MPI_VERSION,", found ",mpiv + ec = ec + 1 + end if + if (mpisv /= MPI_SUBVERSION) then + print *, "MPI_SUBVERSION mismatch, should be ",MPI_SUBVERSION,", found ",mpisv + ec = ec + 1 + end if + end if + end subroutine test_mpi_version diff --git a/tests/ftest_internal.F90 b/tests/ftest_internal.F90 index b94cbca7..9e1f6a67 100644 --- a/tests/ftest_internal.F90 +++ b/tests/ftest_internal.F90 @@ -1,7 +1,7 @@ program test use mpi implicit none - + call test_contiguous() call test_vector() call test_simple_hvector() @@ -12,7 +12,7 @@ program test call test_multiple() stop end - + !!!!!!!!!!!!!!!!!!! ! Contiguous type. Simplest example. Strings 5 ! integers together and tests their equality after @@ -31,9 +31,9 @@ subroutine test_contiguous() print *, "Test Contiguous of 5 x MPI_INTEGER" call mpi_type_contiguous(5, mpi_integer, datatype,ierr) - + call mpi_type_commit(datatype, ierr) - + call print_typemap(datatype,ierr) call copy_data2(a,1,datatype, b,1,datatype, ierr) @@ -47,12 +47,12 @@ subroutine test_contiguous() end !!!!!!!!!!!!!!!!!!!!!!!! -! Vector type. collect a series of indices with +! Vector type. collect a series of indices with ! set stride from an array. !!!!!!!!!!!!!!!!!!!!!!!! subroutine test_vector() - use mpi + use mpi integer ierr integer datatype integer a(10) != (1,2,3,4,5,6,7,8,9,0) @@ -82,7 +82,7 @@ subroutine test_vector() !!!!!!!!!!!!!!!!!!!!! ! Byte-addressed vector. ! values calculated with mpi_type_extent(), -! so basically we are doing the work here in the +! so basically we are doing the work here in the ! test program instead of in the library !!!!!!!!!!!!!!!!!!!!! @@ -174,7 +174,7 @@ subroutine test_simple_bindexed() data index_test/1,2,5,6,8,9/ print *, "Block indexed type" - call mpi_type_indexed_block(3,2,disps,mpi_integer, & + call mpi_type_indexed_block(3,2,disps,mpi_integer, & indexed_type, ierr) call mpi_type_commit(indexed_type, ierr) @@ -252,7 +252,7 @@ subroutine test_packed() integer(kind=mpi_address_kind) disps(3) integer pos - + x = 10 f = 14.333 c = (100, 20) @@ -260,8 +260,8 @@ subroutine test_packed() pos = 0 data blens/1,2,1/, disps/0,4,8/ - - print *, "Packed type " + + print *, "Packed type " call mpi_pack(x, 1, mpi_integer, buf, 100, pos, 0, ierr) call mpi_pack(f, 1, mpi_real, buf, 100, pos, 0, ierr) @@ -287,9 +287,9 @@ subroutine test_packed() end if print *, ">>>PASSED: mpi_pack" - + end subroutine - + !!!!!!!!!!!!!!!!!!!!!!!!! ! Test an indexed send with a multiple receive !!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/type.c b/type.c index 686c625d..8dd93f27 100644 --- a/type.c +++ b/type.c @@ -1,4 +1,4 @@ -/* +/* * JCY * 07/2007 * Derived Datatype functions for mpi-serial @@ -14,8 +14,8 @@ #include #endif -/* - * NOTES: All MPI_ prefixed (public) functions operate +/* + * NOTES: All MPI_ prefixed (public) functions operate * using the integer handle for a datatype. Most of these * functions are wrapper functions for a different function, * _not_ prefixed with MPI_. These functions translate the @@ -27,7 +27,7 @@ /* * Wrapper for mpi_handle_to_ptr in handles.c - * specific for datatype handles, which may be + * specific for datatype handles, which may be * predefined negative handles */ Datatype* mpi_handle_to_datatype(int handle) @@ -60,7 +60,7 @@ int calc_padding(Datatype datatype) } /* Retrieve size of any simple type - * C sizes use sizeof the literal type + * C sizes use sizeof the literal type * they represent. Fortran types are those * as defined in type.h */ @@ -69,19 +69,19 @@ int Simpletype_length(Simpletype t) { switch(t) { - case SIMPLE_CHAR: + case SIMPLE_CHAR: return sizeof(char); break; - case SIMPLE_SHORT: + case SIMPLE_SHORT: return sizeof(short); break; - case SIMPLE_INT: + case SIMPLE_INT: return sizeof(int); break; - case SIMPLE_LONG: + case SIMPLE_LONG: return sizeof(long); break; case SIMPLE_UCHAR: return sizeof(unsigned char); break; - case SIMPLE_USHORT: + case SIMPLE_USHORT: return sizeof(unsigned short); break; - case SIMPLE_UINT: + case SIMPLE_UINT: return sizeof(unsigned int); break; case SIMPLE_ULONG: return sizeof(unsigned long); break; @@ -93,19 +93,19 @@ int Simpletype_length(Simpletype t) return sizeof(long double); break; case SIMPLE_BYTE: return sizeof(char); break; - case SIMPLE_FINTEGER: + case SIMPLE_FINTEGER: return FSIZE_INTEGER; break; - case SIMPLE_FREAL: + case SIMPLE_FREAL: return FSIZE_REAL; break; - case SIMPLE_FDPRECISION: + case SIMPLE_FDPRECISION: return FSIZE_DPRECISION; break; - case SIMPLE_FCOMPLEX: + case SIMPLE_FCOMPLEX: return FSIZE_COMPLEX; break; - case SIMPLE_FDCOMPLEX: + case SIMPLE_FDCOMPLEX: return FSIZE_DCOMPLEX; break; - case SIMPLE_FLOGICAL: + case SIMPLE_FLOGICAL: return FSIZE_LOGICAL; break; - case SIMPLE_FCHARACTER: + case SIMPLE_FCHARACTER: return FSIZE_CHARACTER; break; case SIMPLE_FINTEGER1: return 1; break; @@ -149,11 +149,11 @@ long calc_lb(Datatype type) int i; int min_disp = INT_MAX; typepair * tp; - + for(i =0; i < type->count; i++) { tp = type->pairs+i; - min_disp = tp->disp < min_disp + min_disp = tp->disp < min_disp ? tp->disp : min_disp; } @@ -170,15 +170,15 @@ long calc_ub(Datatype type) int i; long max_disp = INT_MIN; typepair * tp; - + for(i = 0; i < type->count; i++) { tp = type->pairs+i; - max_disp = tp->disp + Simpletype_length(tp->type) > max_disp - ? tp->disp + Simpletype_length(tp->type) + max_disp = tp->disp + Simpletype_length(tp->type) > max_disp + ? tp->disp + Simpletype_length(tp->type) : max_disp; } - + return max_disp; } @@ -193,14 +193,14 @@ FC_FUNC( mpi_type_struct, MPI_TYPE_STRUCT ) (int * count, int * blocklens, long * displacements, int *oldtypes_ptr, int *newtype, int *ierror) { - *ierror=MPI_Type_struct(*count, blocklens, displacements, + *ierror=MPI_Type_struct(*count, blocklens, displacements, oldtypes_ptr, newtype); } /* Public function, wrapper for Type_struct that translates handle to * pointer (see NOTES at top of file) */ -int MPI_Type_struct(int count, int * blocklens, MPI_Aint * displacements, +int MPI_Type_struct(int count, int * blocklens, MPI_Aint * displacements, MPI_Datatype *oldtypes, MPI_Datatype *newtype) { int i; @@ -215,10 +215,10 @@ int MPI_Type_struct(int count, int * blocklens, MPI_Aint * displacements, mpi_alloc_handle(newtype, (void**) &newtype_ptr); return Type_struct(count, blocklens, displacements, - oldtypes_ptr, newtype_ptr); + oldtypes_ptr, newtype_ptr); } -int Type_struct(int count, int * blocklens, MPI_Aint * displacements, +int Type_struct(int count, int * blocklens, MPI_Aint * displacements, Datatype *oldtypes_ptr, Datatype *newtype) { int i, j, k; @@ -238,7 +238,7 @@ int Type_struct(int count, int * blocklens, MPI_Aint * displacements, { //check for MPI_UB or MPI_LB. These types are special // cases and will be skipped over - + temp2 = oldtypes_ptr[i]; if (temp2->pairs[0].type == SIMPLE_LOWER) { @@ -254,7 +254,7 @@ int Type_struct(int count, int * blocklens, MPI_Aint * displacements, new_ub = displacements[i]; override_upper = 1; } - else + else { //this is not MPI_LB or MPI_UB //However it may still have overriding bounds @@ -271,11 +271,11 @@ int Type_struct(int count, int * blocklens, MPI_Aint * displacements, simpletype_count += blocklens[i] * oldtypes_ptr[i]->count; } } - temp = malloc(sizeof(Typestruct) + + temp = malloc(sizeof(Typestruct) + ((simpletype_count-1) * sizeof(typepair))); - + temp->count = simpletype_count; - + i = 0; //old type's index newcount = 0; //new type's index @@ -295,9 +295,9 @@ int Type_struct(int count, int * blocklens, MPI_Aint * displacements, //Copy the old type's typemap and merge into the new type //by a "flattening" process Type_extent((Datatype) oldtypes_ptr[i], &extent); - + tmp_offset = j * extent; - + if (temp2->o_lb && temp2->lb+displacements[i]+tmp_offset < new_lb) new_lb = temp2->lb+displacements[i]+tmp_offset; if (temp2->o_ub && temp2->ub+displacements[i]+tmp_offset > new_ub) @@ -311,7 +311,7 @@ int Type_struct(int count, int * blocklens, MPI_Aint * displacements, (typepair*) (temp->pairs+newcount)); - ((typepair*) temp->pairs+(newcount))->disp += + ((typepair*) temp->pairs+(newcount))->disp += displacements[i] + tmp_offset; newcount++; } @@ -417,7 +417,7 @@ int MPI_Type_vector(int count, int blocklen, int stride, } -int Type_vector(int count, int blocklen, int stride, +int Type_vector(int count, int blocklen, int stride, Datatype oldtype, Datatype *newtype) { MPI_Aint extent; @@ -425,7 +425,7 @@ int Type_vector(int count, int blocklen, int stride, Type_extent(oldtype, &extent); bstride = stride * extent; - + return Type_hvector(count, blocklen, bstride, oldtype, newtype); } @@ -448,8 +448,25 @@ 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, +int Type_hvector(int count, int blocklen, MPI_Aint stride, Datatype oldtype, Datatype *newtype) { int i; @@ -501,7 +518,7 @@ int Type_indexed(int count, int *blocklens, int *displacements, Type_extent(oldtype, &extent); bdisps[i] = displacements[i] * extent; } - + return Type_hindexed(count, blocklens, bdisps, oldtype, newtype); } @@ -511,11 +528,11 @@ FC_FUNC( mpi_type_create_indexed_block, MPI_TYPE_CREATE_INDEXED_BLOCK ) (int * count, int * blocklen, int * displacements, int * oldtype, int * newtype, int * ierr) { - *ierr = MPI_Type_create_indexed_block(*count, *blocklen, displacements, + *ierr = MPI_Type_create_indexed_block(*count, *blocklen, displacements, *oldtype, newtype); } -int MPI_Type_create_indexed_block(int count, int blocklen, int *displacements, +int MPI_Type_create_indexed_block(int count, int blocklen, int *displacements, MPI_Datatype oldtype, MPI_Datatype * newtype) { int ret; @@ -531,10 +548,10 @@ int Type_create_indexed_block(int count, int blocklen, int *displacements, { int i; int blocklens[count]; - + for (i = 0; i < count; i++) blocklens[i] = blocklen; - + return Type_indexed(count, blocklens, displacements, oldtype, newtype); } @@ -558,17 +575,17 @@ int MPI_Type_hindexed(int count, int *blocklens, MPI_Aint * disps, return Type_hindexed(count, blocklens, disps, old_ptr, new_ptr); } -int Type_hindexed(int count, int *blocklens, MPI_Aint *displacements, +int Type_hindexed(int count, int *blocklens, MPI_Aint *displacements, Datatype oldtype, Datatype *newtype) { int i; Datatype oldtypes[count]; - + for (i = 0; i < count; i++) { oldtypes[i] = oldtype; } - + return Type_struct(count, blocklens, displacements, oldtypes, newtype); } @@ -687,8 +704,8 @@ int FGet_address(void * loc, long * address, int * ierr) } int MPI_Address(void * loc, MPI_Aint * address) -{ - return MPI_Get_address(loc, address); +{ + return MPI_Get_address(loc, address); } int MPI_Get_address(void * loc, MPI_Aint * address) @@ -729,7 +746,7 @@ int Type_extent(Datatype datatype, MPI_Aint * extent) { *extent = datatype->ub - datatype->lb; } - + return MPI_SUCCESS; } @@ -775,7 +792,7 @@ FC_FUNC( mpi_type_free, MPI_TYPE_FREE )(int * datatype, int * ierr) } int MPI_Type_free(MPI_Datatype * datatype) -{ +{ Datatype type_ptr = *(Datatype*) mpi_handle_to_datatype(*datatype); free(type_ptr); type_ptr = MPI_DATATYPE_NULL; @@ -814,7 +831,7 @@ int Pprint_typemap(Datatype type) for (i = 0; i < type->count; i++) { - printf("(t%d:%d, o%d)", type->pairs[i].type, + printf("(t%d:%d, o%d)", type->pairs[i].type, Simpletype_length(type->pairs[i].type), type->pairs[i].disp); diff --git a/type.h b/type.h index df5b4e45..cd92b78f 100644 --- a/type.h +++ b/type.h @@ -2,7 +2,7 @@ #define TYPE_H /* type.h */ -/* defines interface and types used for mpi-serial user-defined datatypes */ +/* defines interface and types used for mpi-serial user-defined datatypes */ #include "mpiP.h" @@ -12,7 +12,7 @@ #endif //predefined type value used in typemap -typedef int Simpletype; +typedef int Simpletype; typedef struct { @@ -20,7 +20,7 @@ typedef struct Simpletype type; } typepair; -typedef struct +typedef struct { int count; long ub; @@ -37,7 +37,7 @@ typedef struct typedef Typestruct* Datatype; -//Simpletype constants +//Simpletype constants #define SIMPLE_CHAR 0 #define SIMPLE_SHORT 1 #define SIMPLE_INT 2 @@ -79,7 +79,7 @@ typedef Typestruct* Datatype; #define SIMPLE_OFFSET 34 -//internal type functions +//internal type functions int Simpletype_length(Simpletype s); //testing only @@ -103,7 +103,7 @@ int print_typemap(MPI_Datatype in); #endif #ifdef CONFIG_FORT_DOUBLE -#define FSIZE_DPRECISION CONFIG_FORT_DOUBLE +#define FSIZE_DPRECISION CONFIG_FORT_DOUBLE #else #define FSIZE_DPRECISION 8 #endif @@ -119,6 +119,6 @@ Datatype* mpi_handle_to_datatype(int handle); extern int Unpack(void * inbuf, int insize, int * position, void *outbuf, int outcount, Datatype type, Comm* comm); -extern int Pack(void *inbuf, int incount, Datatype type, +extern int Pack(void *inbuf, int incount, Datatype type, void *outbuf, int outsize, int *position, Comm * comm); #endif /* TYPE_H */ diff --git a/type_const.c b/type_const.c index c746bb37..fcb6ed4e 100644 --- a/type_const.c +++ b/type_const.c @@ -7,34 +7,34 @@ Typestruct TSchar = {.count=1, .lb=0, .ub=sizeof(char), .committed=1, .o_lb=0, .o_ub=0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_CHAR }}; - Typestruct TSshort = {.count=1, .lb=0, .ub=sizeof(short), + Typestruct TSshort = {.count=1, .lb=0, .ub=sizeof(short), .committed=1, .o_lb=0, .o_ub=0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_SHORT }}; - Typestruct TSint = {.count = 1, .lb = 0, .ub=sizeof(int), + Typestruct TSint = {.count = 1, .lb = 0, .ub=sizeof(int), .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0]= {.disp = 0, .type = (Simpletype) SIMPLE_INT }}; - Typestruct TSlong = {.count = 1, .lb = 0, .ub = sizeof(long), + Typestruct TSlong = {.count = 1, .lb = 0, .ub = sizeof(long), .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_LONG }}; Typestruct TSuchar = {.count = 1, .lb = 0, .ub=sizeof(unsigned char), - .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = + .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_UCHAR }}; Typestruct TSushort = {.count = 1, .lb = 0, .ub=sizeof(unsigned short), - .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = + .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_USHORT }}; Typestruct TSuint = {.count = 1, .lb = 0, .ub = sizeof(unsigned int), - .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = + .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_UINT }}; - Typestruct TSulong = {.count = 1, .lb = 0, .ub = sizeof(unsigned long), - .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = + Typestruct TSulong = {.count = 1, .lb = 0, .ub = sizeof(unsigned long), + .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_ULONG }}; - Typestruct TSfloat = {.count = 1, .lb = 0, .ub = sizeof(float), + Typestruct TSfloat = {.count = 1, .lb = 0, .ub = sizeof(float), .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_FLOAT }}; Typestruct TSdouble = {.count = 1, .lb = 0, .ub = sizeof(double), - .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = + .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_DOUBLE }}; - Typestruct TSldouble = {.count = 1, .lb = 0, .ub = sizeof(long double), + Typestruct TSldouble = {.count = 1, .lb = 0, .ub = sizeof(long double), .committed=1,.o_lb = 0, .o_ub = 0, .pairs[0] = {.disp = 0, .type = (Simpletype) SIMPLE_LDOUBLE }}; @@ -47,7 +47,7 @@ .o_lb = 0, .o_ub = 0, .pairs[0] = { .disp = 0, .type = (Simpletype) SIMPLE_LOWER } }; Typestruct TSupper = { .count = 1, .lb = 0, .ub = 0, .committed = 1, .o_lb = 0, .o_ub = 0, .pairs[0] = { .disp = 0, .type = (Simpletype) SIMPLE_UPPER } }; - + //Fortran type structs Typestruct TSinteger = { .count = 1, .lb = 0, .ub = FSIZE_INTEGER, .committed = 1, .o_lb = 0, .o_ub = 0, .pairs[0] = { .disp = 0, .type = (Simpletype) SIMPLE_FINTEGER } }; @@ -99,7 +99,7 @@ /* Fortran sized types - */ + */ Typestruct TSinteger1 = {.count = 1, .lb = 0, .ub=1, .committed=1, .o_lb = 0, .o_ub = 0, .pairs[0]= @@ -168,8 +168,8 @@ Typestruct TSoffset = {.count = 1, .lb = 0, .ub=sizeof(MPI_Offset), * This should be coded in a better way to avoid human error. */ - const Datatype simpletypes[64] = - {&TSchar , &TSshort , &TSint , &TSlong, + const Datatype simpletypes[64] = + {&TSchar , &TSshort , &TSint , &TSlong, &TSuchar , &TSushort , &TSuint , &TSulong, //4 &TSfloat , &TSdouble , &TSldouble , &TSbyte, //8 &TSpacked , &TSlower , &TSupper , &TSinteger, //12 @@ -177,11 +177,11 @@ Typestruct TSoffset = {.count = 1, .lb = 0, .ub=sizeof(MPI_Offset), &TSlogical , &TScharacter , &TS2real , &TS2dprecision,//20 &TS2integer, &TSfloat_int , &TSdouble_int , &TSlong_int, //24 &TS2int , &TSshort_int , &TSldouble_int, &TSinteger1, //28 - &TSinteger2, &TSinteger4 , &TSinteger8 , &TSinteger16, //32 + &TSinteger2, &TSinteger4 , &TSinteger8 , &TSinteger16, //32 &TSreal4 , &TSreal8 , &TSreal16 , &TScomplex8, //36 &TScomplex16, &TScomplex32, &TSlonglong , &TSulonglong, //40 &TSoffset - }; + }; /* optional datatypes (Fortran) MPI_INTEGER1 MPI_INTEGER2 MPI_INTEGER4 MPI_REAL2 MPI_REAL4 MPI_REAL8