From bb12a168512ced7a0f1e4924d367c87ed7c22d1c Mon Sep 17 00:00:00 2001 From: Arnaud Giersch Date: Thu, 23 Sep 2021 11:37:22 +0200 Subject: [PATCH] Kill trailing whitespaces in teshsuite/smpi/{isp,mpich3-test}. At first I hesitated to touch these files, then I saw that they had already undergone a first cleaning pass some time ago. --- .../smpi/isp/umpire/any_src-wait-deadlock2.c | 2 +- .../isp/umpire/basic-deadlock-cart_create.c | 2 +- .../smpi/isp/umpire/basic-deadlock-cart_sub.c | 2 +- .../isp/umpire/basic-deadlock-comm_create.c | 2 +- .../isp/umpire/basic-deadlock-comm_split.c | 2 +- .../isp/umpire/basic-deadlock-graph_create.c | 2 +- .../umpire/basic-deadlock-intercomm_create.c | 4 +- .../umpire/basic-deadlock-intercomm_merge.c | 4 +- teshsuite/smpi/isp/umpire/bcast-deadlock.c | 8 +- .../umpire/change-send-buffer-exhaustive.c | 8 +- .../change-send-buffer-type-exhaustive.c | 6 +- .../isp/umpire/intercomm_create-deadlock.c | 8 +- .../isp/umpire/intercomm_create-deadlock2.c | 6 +- .../isp/umpire/intercomm_create-deadlock3.c | 6 +- .../isp/umpire/intercomm_create-deadlock4.c | 8 +- .../isp/umpire/intercomm_merge-deadlock.c | 8 +- .../no-error-persistent-all-completions.c | 8 +- teshsuite/smpi/isp/umpire/no-error-testany.c | 2 +- .../smpi/isp/umpire/no-error-wait-any_src3.c | 2 +- .../isp/umpire/no-error-waitany-any_src.c | 2 +- teshsuite/smpi/isp/umpire/no-error-waitany.c | 2 +- teshsuite/smpi/isp/umpire/no-error-waitany2.c | 2 +- .../smpi/isp/umpire/partial-recv-exhaustive.c | 54 ++++----- .../isp/umpire/partial-recv-persistent4.c | 2 +- teshsuite/smpi/isp/umpire/partial-recv.c | 4 +- .../smpi/isp/umpire/pt2pt-byte-int-mismatch.c | 54 ++++----- .../type-no-error-exhaustive-with-isends.c | 6 +- teshsuite/smpi/isp/umpire/waitany-deadlock.c | 2 +- teshsuite/smpi/mpich3-test/README | 62 +++++------ .../smpi/mpich3-test/f77/attr/attrmpi1f.f | 6 +- .../smpi/mpich3-test/f77/attr/baseattr2f.f | 20 ++-- .../smpi/mpich3-test/f77/attr/baseattrf.f | 6 +- .../smpi/mpich3-test/f77/attr/commattr2f.f | 20 ++-- .../smpi/mpich3-test/f77/attr/commattr3f.f | 14 +-- .../smpi/mpich3-test/f77/attr/commattrf.f | 20 ++-- .../smpi/mpich3-test/f77/attr/typeattr2f.f | 20 ++-- .../smpi/mpich3-test/f77/attr/typeattr3f.f | 14 +-- .../smpi/mpich3-test/f77/attr/typeattrf.f | 20 ++-- .../smpi/mpich3-test/f77/coll/allredint8f.f | 8 +- .../smpi/mpich3-test/f77/coll/allredopttf.f | 14 +-- .../smpi/mpich3-test/f77/coll/alltoallvf.f | 20 ++-- .../smpi/mpich3-test/f77/coll/alltoallwf.f | 14 +-- teshsuite/smpi/mpich3-test/f77/coll/exscanf.f | 18 +-- .../smpi/mpich3-test/f77/coll/inplacef.f | 18 +-- .../mpich3-test/f77/coll/nonblocking_inpf.f | 2 +- .../smpi/mpich3-test/f77/coll/nonblockingf.f | 10 +- .../mpich3-test/f77/coll/red_scat_blockf.f | 2 +- .../smpi/mpich3-test/f77/coll/redscatf.f | 12 +- .../smpi/mpich3-test/f77/coll/reducelocalf.f | 12 +- .../smpi/mpich3-test/f77/coll/uallreducef.f | 10 +- .../smpi/mpich3-test/f77/coll/vw_inplacef.f | 2 +- .../smpi/mpich3-test/f77/comm/commerrf.f | 14 +-- .../smpi/mpich3-test/f77/comm/commnamef.f | 6 +- .../mpich3-test/f77/datatype/allctypesf.f | 28 ++--- .../smpi/mpich3-test/f77/datatype/gaddressf.f | 2 +- .../smpi/mpich3-test/f77/datatype/hindex1f.f | 12 +- .../smpi/mpich3-test/f77/datatype/packef.f | 30 ++--- .../smpi/mpich3-test/f77/datatype/typecntsf.f | 12 +- .../smpi/mpich3-test/f77/datatype/typem2f.f | 30 ++--- .../mpich3-test/f77/datatype/typename3f.f | 2 +- .../smpi/mpich3-test/f77/datatype/typenamef.f | 2 +- .../mpich3-test/f77/datatype/typesnamef.f | 8 +- .../smpi/mpich3-test/f77/datatype/typesubf.f | 8 +- .../smpi/mpich3-test/f77/ext/allocmemf.f | 4 +- teshsuite/smpi/mpich3-test/f77/ext/c2f2c.c | 2 +- teshsuite/smpi/mpich3-test/f77/ext/c2f2cf.f | 8 +- .../smpi/mpich3-test/f77/ext/ctypesinf.f | 4 +- .../smpi/mpich3-test/f77/info/infotest2f.f | 20 ++-- .../smpi/mpich3-test/f77/info/infotestf.f | 8 +- .../smpi/mpich3-test/f77/init/baseenvf.f | 10 +- .../smpi/mpich3-test/f77/pt2pt/allpairf.f | 104 +++++++++--------- teshsuite/smpi/mpich3-test/f77/pt2pt/dummyf.f | 6 +- teshsuite/smpi/mpich3-test/f77/pt2pt/greqf.f | 22 ++-- .../smpi/mpich3-test/f77/pt2pt/mprobef.f | 14 +-- .../smpi/mpich3-test/f77/pt2pt/statusesf.f | 12 +- .../smpi/mpich3-test/f77/rma/baseattrwinf.f | 18 +-- .../smpi/mpich3-test/f77/rma/c2f2cwinf.f | 10 +- teshsuite/smpi/mpich3-test/f77/rma/winaccf.f | 24 ++-- .../smpi/mpich3-test/f77/rma/winattr2f.f | 18 +-- teshsuite/smpi/mpich3-test/f77/rma/winattrf.f | 26 ++--- teshsuite/smpi/mpich3-test/f77/rma/winerrf.f | 14 +-- .../smpi/mpich3-test/f77/rma/winfencef.f | 24 ++-- teshsuite/smpi/mpich3-test/f77/rma/wingetf.f | 22 ++-- .../smpi/mpich3-test/f77/rma/wingroupf.f | 8 +- teshsuite/smpi/mpich3-test/f77/rma/winnamef.f | 8 +- .../smpi/mpich3-test/f77/rma/winscale1f.f | 20 ++-- .../smpi/mpich3-test/f77/rma/winscale2f.f | 22 ++-- teshsuite/smpi/mpich3-test/f77/topo/cartcrf.f | 10 +- .../smpi/mpich3-test/f77/topo/dgraph_unwgtf.f | 10 +- .../smpi/mpich3-test/f77/topo/dgraph_wgtf.f | 8 +- teshsuite/smpi/mpich3-test/f77/util/mtestf.f | 16 +-- .../mpich3-test/f90/coll/allredint8f90.f90 | 6 +- .../mpich3-test/f90/coll/allredopttf90.f90 | 4 +- .../mpich3-test/f90/coll/alltoallvf90.f90 | 14 +-- .../mpich3-test/f90/coll/alltoallwf90.f90 | 12 +- .../smpi/mpich3-test/f90/coll/exscanf90.f90 | 10 +- .../smpi/mpich3-test/f90/coll/inplacef90.f90 | 14 +-- .../f90/coll/nonblocking_inpf90.f90 | 2 +- .../mpich3-test/f90/coll/nonblockingf90.f90 | 4 +- .../f90/coll/red_scat_blockf90.f90 | 2 +- .../smpi/mpich3-test/f90/coll/redscatf90.f90 | 10 +- .../mpich3-test/f90/coll/reducelocalf90.f90 | 12 +- .../mpich3-test/f90/coll/uallreducef90.f90 | 8 +- .../mpich3-test/f90/coll/vw_inplacef90.f90 | 2 +- .../mpich3-test/f90/datatype/allctypesf90.f90 | 12 +- .../mpich3-test/f90/datatype/createf90.f90 | 6 +- .../mpich3-test/f90/datatype/gaddressf90.f90 | 2 +- .../mpich3-test/f90/datatype/get_elem_d.f90 | 2 +- .../mpich3-test/f90/datatype/get_elem_u.f90 | 28 ++--- .../mpich3-test/f90/datatype/hindex1f90.f90 | 12 +- .../smpi/mpich3-test/f90/datatype/indtype.f90 | 12 +- .../smpi/mpich3-test/f90/datatype/kinds.f90 | 4 +- .../mpich3-test/f90/datatype/packef90.f90 | 14 +-- .../smpi/mpich3-test/f90/datatype/sizeof.f90 | 4 +- .../smpi/mpich3-test/f90/datatype/structf.f90 | 10 +- .../smpi/mpich3-test/f90/datatype/trf90.f90 | 2 +- .../mpich3-test/f90/datatype/typecntsf90.f90 | 8 +- .../mpich3-test/f90/datatype/typem2f90.f90 | 2 +- .../mpich3-test/f90/datatype/typename3f90.f90 | 2 +- .../mpich3-test/f90/datatype/typenamef90.f90 | 2 +- .../mpich3-test/f90/datatype/typesnamef90.f90 | 8 +- .../mpich3-test/f90/datatype/typesubf90.f90 | 2 +- .../mpich3-test/f90/info/infotest2f90.f90 | 10 +- .../smpi/mpich3-test/f90/info/infotestf90.f90 | 8 +- .../smpi/mpich3-test/f90/init/baseenvf90.f90 | 6 +- .../smpi/mpich3-test/f90/pt2pt/allpairf90.f90 | 80 +++++++------- .../smpi/mpich3-test/f90/pt2pt/dummyf90.f90 | 6 +- .../smpi/mpich3-test/f90/pt2pt/greqf90.f90 | 18 +-- .../smpi/mpich3-test/f90/pt2pt/mprobef90.f90 | 14 +-- .../mpich3-test/f90/pt2pt/statusesf90.f90 | 12 +- .../mpich3-test/f90/rma/baseattrwinf90.f90 | 12 +- .../smpi/mpich3-test/f90/rma/c2f2cwinf90.f90 | 8 +- .../smpi/mpich3-test/f90/rma/winaccf90.f90 | 14 +-- .../smpi/mpich3-test/f90/rma/winattr2f90.f90 | 10 +- .../smpi/mpich3-test/f90/rma/winattrf90.f90 | 18 +-- .../smpi/mpich3-test/f90/rma/winerrf90.f90 | 6 +- .../smpi/mpich3-test/f90/rma/winfencef90.f90 | 14 +-- .../smpi/mpich3-test/f90/rma/wingetf90.f90 | 14 +-- .../smpi/mpich3-test/f90/rma/wingroupf90.f90 | 6 +- .../smpi/mpich3-test/f90/rma/winnamef90.f90 | 6 +- .../smpi/mpich3-test/f90/rma/winscale1f90.f90 | 14 +-- .../smpi/mpich3-test/f90/rma/winscale2f90.f90 | 14 +-- .../smpi/mpich3-test/f90/util/mtestf90.f90 | 12 +- teshsuite/smpi/mpich3-test/perf/README | 3 +- teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c | 2 +- 145 files changed, 862 insertions(+), 865 deletions(-) diff --git a/teshsuite/smpi/isp/umpire/any_src-wait-deadlock2.c b/teshsuite/smpi/isp/umpire/any_src-wait-deadlock2.c index 1ab9cf97e3..572a26590b 100644 --- a/teshsuite/smpi/isp/umpire/any_src-wait-deadlock2.c +++ b/teshsuite/smpi/isp/umpire/any_src-wait-deadlock2.c @@ -42,7 +42,7 @@ main (int argc, char **argv) printf("Proc 0: Request number - %p\n",req); MPI_Send (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD); - + MPI_Recv (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD, &status); MPI_Send (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD); diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-cart_create.c b/teshsuite/smpi/isp/umpire/basic-deadlock-cart_create.c index 61a7d12e45..67c86e0067 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-cart_create.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-cart_create.c @@ -54,7 +54,7 @@ main (int argc, char **argv) memset (buf0, 0, buf_size*sizeof(int)); MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); } else if (drank == 1) { diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-cart_sub.c b/teshsuite/smpi/isp/umpire/basic-deadlock-cart_sub.c index 902fad2449..1fc0879f28 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-cart_sub.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-cart_sub.c @@ -67,7 +67,7 @@ main (int argc, char **argv) memset (buf0, 0, buf_size*sizeof(int)); MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); } else if (drank == 1) { diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-comm_create.c b/teshsuite/smpi/isp/umpire/basic-deadlock-comm_create.c index 0bcb22d570..c70951909f 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-comm_create.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-comm_create.c @@ -59,7 +59,7 @@ main (int argc, char **argv) memset (buf0, 0, buf_size*sizeof(int)); MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); } else if (drank == 1) { diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-comm_split.c b/teshsuite/smpi/isp/umpire/basic-deadlock-comm_split.c index e6551cbe8c..826f80c2c0 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-comm_split.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-comm_split.c @@ -45,7 +45,7 @@ main (int argc, char **argv) memset (buf0, 0, buf_size*sizeof(int)); MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); } else if (drank == 1) { diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-graph_create.c b/teshsuite/smpi/isp/umpire/basic-deadlock-graph_create.c index fe3df2b772..f7351ed767 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-graph_create.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-graph_create.c @@ -51,7 +51,7 @@ main (int argc, char **argv) memset (buf0, 0, buf_size*sizeof(int)); MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); } else if (drank == 1) { diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_create.c b/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_create.c index c04617d2b0..92df65d1f1 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_create.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_create.c @@ -62,9 +62,9 @@ main (int argc, char **argv) } else { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Recv (buf1, buf_size, MPI_INT, drank, 0, intercomm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, drank, 0, intercomm); } } diff --git a/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_merge.c b/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_merge.c index 6054a7d1b4..2a1f1acdb5 100644 --- a/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_merge.c +++ b/teshsuite/smpi/isp/umpire/basic-deadlock-intercomm_merge.c @@ -65,9 +65,9 @@ main (int argc, char **argv) if (dnprocs > 1) { if (drank == 0) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); } else if (drank == 1) { diff --git a/teshsuite/smpi/isp/umpire/bcast-deadlock.c b/teshsuite/smpi/isp/umpire/bcast-deadlock.c index 6b90e8675c..66e7c384c4 100644 --- a/teshsuite/smpi/isp/umpire/bcast-deadlock.c +++ b/teshsuite/smpi/isp/umpire/bcast-deadlock.c @@ -25,15 +25,15 @@ main (int argc, char **argv) if (rank == 0) { memset (buf0, 0, buf_size*sizeof(int)); - MPI_Bcast (buf0, buf_size, MPI_INT, 1, MPI_COMM_WORLD); - MPI_Bcast (buf0, buf_size, MPI_INT, 0, MPI_COMM_WORLD); + MPI_Bcast (buf0, buf_size, MPI_INT, 1, MPI_COMM_WORLD); + MPI_Bcast (buf0, buf_size, MPI_INT, 0, MPI_COMM_WORLD); } else { if (rank == 1) memset (buf1, 1, buf_size*sizeof(int)); - MPI_Bcast (buf0, buf_size, MPI_INT, 0, MPI_COMM_WORLD); - MPI_Bcast (buf0, buf_size, MPI_INT, 1, MPI_COMM_WORLD); + MPI_Bcast (buf0, buf_size, MPI_INT, 0, MPI_COMM_WORLD); + MPI_Bcast (buf0, buf_size, MPI_INT, 1, MPI_COMM_WORLD); } MPI_Finalize (); diff --git a/teshsuite/smpi/isp/umpire/change-send-buffer-exhaustive.c b/teshsuite/smpi/isp/umpire/change-send-buffer-exhaustive.c index aec87df2de..2ac360136d 100644 --- a/teshsuite/smpi/isp/umpire/change-send-buffer-exhaustive.c +++ b/teshsuite/smpi/isp/umpire/change-send-buffer-exhaustive.c @@ -165,7 +165,7 @@ main (int argc, char **argv) MPI_Wait (&aReq[j], &aStatus[j]); } break; - + case 1: /* use MPI_Waitall */ MPI_Waitall (NUM_SEND_TYPES * 2, aReq, aStatus); @@ -178,7 +178,7 @@ main (int argc, char **argv) } break; - + case 3: /* use MPI_Waitsome */ total = 0; @@ -201,7 +201,7 @@ main (int argc, char **argv) } break; - + case 5: /* use MPI_Testall */ flag = 0; @@ -221,7 +221,7 @@ main (int argc, char **argv) } break; - + case 7: /* use MPI_Testsome */ total = 0; diff --git a/teshsuite/smpi/isp/umpire/change-send-buffer-type-exhaustive.c b/teshsuite/smpi/isp/umpire/change-send-buffer-type-exhaustive.c index 9cbee5697c..8ce9636563 100644 --- a/teshsuite/smpi/isp/umpire/change-send-buffer-type-exhaustive.c +++ b/teshsuite/smpi/isp/umpire/change-send-buffer-type-exhaustive.c @@ -209,7 +209,7 @@ main (int argc, char **argv) struct_lb_ub_send_buf[i].dontsend_double2 = 1.0; #endif } - + /* set up the sends */ #ifdef RUN_TYPE_STRUCT MPI_Isend (struct_buf, MSG_COUNT, newtype[0], 1, 0, comm, &aReq[0]); @@ -395,7 +395,7 @@ main (int argc, char **argv) struct_lb_ub_send_buf[i].the_chars[0] = 'c'; #endif } - + if ((rank == 0) || (rank == 1)) /* wait on everything... */ MPI_Waitall (TYPE_CONSTRUCTOR_COUNT, aReq, aStatus); @@ -734,7 +734,7 @@ main (int argc, char **argv) #endif } } - + for (i = 0; i < TYPE_CONSTRUCTOR_COUNT; i++) MPI_Type_free (&newtype[i]); diff --git a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock.c b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock.c index 9165e0d06d..9de9bbec81 100644 --- a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock.c +++ b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock.c @@ -55,9 +55,9 @@ main (int argc, char **argv) INTERCOMM_CREATE_TAG, &intercomm); if (tnprocs > 1) { - if (trank == 0) { + if (trank == 0) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, temp); } } @@ -82,9 +82,9 @@ main (int argc, char **argv) } else { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, drank, 0, intercomm); - + MPI_Recv (buf1, buf_size, MPI_INT, drank, 0, intercomm, &status); } } diff --git a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock2.c b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock2.c index fe6411eb27..8eae0c49a0 100644 --- a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock2.c +++ b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock2.c @@ -57,7 +57,7 @@ main (int argc, char **argv) if ((trank == 0) && !(rank % 2)) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, temp); } else { @@ -81,9 +81,9 @@ main (int argc, char **argv) } else { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, drank, 0, intercomm); - + MPI_Recv (buf1, buf_size, MPI_INT, drank, 0, intercomm, &status); } } diff --git a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock3.c b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock3.c index 663ded7e29..5f42b245dc 100644 --- a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock3.c +++ b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock3.c @@ -56,7 +56,7 @@ main (int argc, char **argv) if (rank == 0) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD); } @@ -77,9 +77,9 @@ main (int argc, char **argv) } else { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, drank, 0, intercomm); - + MPI_Recv (buf1, buf_size, MPI_INT, drank, 0, intercomm, &status); } } diff --git a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock4.c b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock4.c index 25a53b59d1..f7746d7564 100644 --- a/teshsuite/smpi/isp/umpire/intercomm_create-deadlock4.c +++ b/teshsuite/smpi/isp/umpire/intercomm_create-deadlock4.c @@ -59,12 +59,12 @@ main (int argc, char **argv) if (rank == 2) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, rleader, 0, MPI_COMM_WORLD); } else if (rank == 1) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, 0, 0, MPI_COMM_WORLD); } @@ -85,9 +85,9 @@ main (int argc, char **argv) } else { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, drank, 0, intercomm); - + MPI_Recv (buf1, buf_size, MPI_INT, drank, 0, intercomm, &status); } } diff --git a/teshsuite/smpi/isp/umpire/intercomm_merge-deadlock.c b/teshsuite/smpi/isp/umpire/intercomm_merge-deadlock.c index aeb4993c98..6cabf5c2a3 100644 --- a/teshsuite/smpi/isp/umpire/intercomm_merge-deadlock.c +++ b/teshsuite/smpi/isp/umpire/intercomm_merge-deadlock.c @@ -87,9 +87,9 @@ main (int argc, char **argv) } else if (drank == 0) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm); - + MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm, &status); } } @@ -110,9 +110,9 @@ main (int argc, char **argv) } else if (drank == 0) { memset (buf0, 0, buf_size*sizeof(int)); - + MPI_Send (buf0, buf_size, MPI_INT, 1, 0, comm2); - + MPI_Recv (buf1, buf_size, MPI_INT, 1, 0, comm2, &status); } } diff --git a/teshsuite/smpi/isp/umpire/no-error-persistent-all-completions.c b/teshsuite/smpi/isp/umpire/no-error-persistent-all-completions.c index 6d9648fed9..0b05874378 100644 --- a/teshsuite/smpi/isp/umpire/no-error-persistent-all-completions.c +++ b/teshsuite/smpi/isp/umpire/no-error-persistent-all-completions.c @@ -76,7 +76,7 @@ main (int argc, char **argv) MPI_Wait (&aReq[j], &aStatus[j]); } break; - + case 1: /* use MPI_Waitall */ MPI_Waitall (2, aReq, aStatus); @@ -88,7 +88,7 @@ main (int argc, char **argv) MPI_Waitany (2, aReq, &index, aStatus); } break; - + case 3: /* use MPI_Waitsome */ j = 0; @@ -107,7 +107,7 @@ main (int argc, char **argv) } } break; - + case 5: /* use MPI_Testall */ flag = 0; @@ -125,7 +125,7 @@ main (int argc, char **argv) } } break; - + case 7: /* use MPI_Testsome */ j = 0; diff --git a/teshsuite/smpi/isp/umpire/no-error-testany.c b/teshsuite/smpi/isp/umpire/no-error-testany.c index 01acc8003f..dc3422ba07 100644 --- a/teshsuite/smpi/isp/umpire/no-error-testany.c +++ b/teshsuite/smpi/isp/umpire/no-error-testany.c @@ -60,7 +60,7 @@ main (int argc, char **argv) for (i = 3; i > 0; i--) { MPI_Recv (&flipbit, 1, MPI_INT, 0, i, MPI_COMM_WORLD, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 0, i, MPI_COMM_WORLD); } } diff --git a/teshsuite/smpi/isp/umpire/no-error-wait-any_src3.c b/teshsuite/smpi/isp/umpire/no-error-wait-any_src3.c index eedca26a63..70bdf9c1a4 100644 --- a/teshsuite/smpi/isp/umpire/no-error-wait-any_src3.c +++ b/teshsuite/smpi/isp/umpire/no-error-wait-any_src3.c @@ -50,7 +50,7 @@ main (int argc, char **argv) for (i = 0; i < NUMREPS; i++) { MPI_Send (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD); - + MPI_Recv (buf0, buf_size, MPI_INT, 1, 0, MPI_COMM_WORLD, &status); } diff --git a/teshsuite/smpi/isp/umpire/no-error-waitany-any_src.c b/teshsuite/smpi/isp/umpire/no-error-waitany-any_src.c index dcfc430ba0..d3a584acea 100644 --- a/teshsuite/smpi/isp/umpire/no-error-waitany-any_src.c +++ b/teshsuite/smpi/isp/umpire/no-error-waitany-any_src.c @@ -61,7 +61,7 @@ main (int argc, char **argv) for (i = 3; i > 0; i--) { MPI_Recv (&flipbit, 1, MPI_INT, MPI_ANY_SOURCE, i, MPI_COMM_WORLD, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 0, i, MPI_COMM_WORLD); } } diff --git a/teshsuite/smpi/isp/umpire/no-error-waitany.c b/teshsuite/smpi/isp/umpire/no-error-waitany.c index 6f90c53f3c..9ac0495dd1 100644 --- a/teshsuite/smpi/isp/umpire/no-error-waitany.c +++ b/teshsuite/smpi/isp/umpire/no-error-waitany.c @@ -57,7 +57,7 @@ main (int argc, char **argv) for (i = 3; i > 0; i--) { MPI_Recv (&flipbit, 1, MPI_INT, 0, i, MPI_COMM_WORLD, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 0, i, MPI_COMM_WORLD); } } diff --git a/teshsuite/smpi/isp/umpire/no-error-waitany2.c b/teshsuite/smpi/isp/umpire/no-error-waitany2.c index fad99caf2a..9ca6b79577 100644 --- a/teshsuite/smpi/isp/umpire/no-error-waitany2.c +++ b/teshsuite/smpi/isp/umpire/no-error-waitany2.c @@ -70,7 +70,7 @@ printf ("Done = %d\n", done); for (i = 3; i >= 0; i--) { MPI_Recv (&flipbit, 1, MPI_INT, 0, i, MPI_COMM_WORLD, &status); - + if (i > 0) { MPI_Send (buf0, buf_size, MPI_INT, 0, i, MPI_COMM_WORLD); } diff --git a/teshsuite/smpi/isp/umpire/partial-recv-exhaustive.c b/teshsuite/smpi/isp/umpire/partial-recv-exhaustive.c index 0759c7a054..151755001d 100644 --- a/teshsuite/smpi/isp/umpire/partial-recv-exhaustive.c +++ b/teshsuite/smpi/isp/umpire/partial-recv-exhaustive.c @@ -123,7 +123,7 @@ main (int argc, char **argv) comm, &aReq[send_t_number * 2 + 1]); send_t_number++; - + MPI_Ibsend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT, 1, send_t_number * 2, comm, &aReq[send_t_number * 2]); MPI_Ibsend (&buf[(send_t_number * 2 + 1) * BUF_SIZE], @@ -134,7 +134,7 @@ main (int argc, char **argv) /* Barrier to ensure receives are posted for rsends... */ MPI_Barrier(MPI_COMM_WORLD); - + MPI_Irsend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT, 1, send_t_number * 2, comm, &aReq[send_t_number * 2]); MPI_Irsend (&buf[(send_t_number * 2 + 1) * BUF_SIZE], @@ -164,7 +164,7 @@ main (int argc, char **argv) MPI_Start (&aReq[2 * send_t_number + j]); } } - + /* complete the sends */ switch (k/2) { case 0: @@ -173,7 +173,7 @@ main (int argc, char **argv) MPI_Wait (&aReq[j], &aStatus[j]); } break; - + case 1: /* use MPI_Waitall */ MPI_Waitall (NUM_SEND_TYPES * 2, aReq, aStatus); @@ -184,9 +184,9 @@ main (int argc, char **argv) for (j = 0; j < NUM_SEND_TYPES * 2; j++) { MPI_Waitany (NUM_SEND_TYPES * 2, aReq, &index, aStatus); } - + break; - + case 3: /* use MPI_Waitsome */ total = 0; @@ -203,23 +203,23 @@ main (int argc, char **argv) /* use MPI_Test */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { flag = 0; - + while (!flag) { MPI_Test (&aReq[j], &flag, &aStatus[j]); } } - + break; - + case 5: /* use MPI_Testall */ flag = 0; while (!flag) { MPI_Testall (NUM_SEND_TYPES * 2, aReq, &flag, aStatus); } - + break; - + case 6: /* use MPI_Testany */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { @@ -231,7 +231,7 @@ main (int argc, char **argv) } break; - + case 7: /* use MPI_Testsome */ total = 0; @@ -276,7 +276,7 @@ main (int argc, char **argv) /* Barrier to ensure receives are posted for rsends... */ MPI_Barrier(MPI_COMM_WORLD); - + /* complete all of the receives... */ switch (l/2) { case 0: @@ -285,7 +285,7 @@ main (int argc, char **argv) MPI_Wait (&aReq[j], &aStatus[j]); } break; - + case 1: /* use MPI_Waitall */ MPI_Waitall (NUM_SEND_TYPES * 2, aReq, aStatus); @@ -296,9 +296,9 @@ main (int argc, char **argv) for (j = 0; j < NUM_SEND_TYPES * 2; j++) { MPI_Waitany (NUM_SEND_TYPES * 2, aReq, &index, aStatus); } - + break; - + case 3: /* use MPI_Waitsome */ total = 0; @@ -310,28 +310,28 @@ main (int argc, char **argv) } break; - + case 4: /* use MPI_Test */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { flag = 0; - + while (!flag) { MPI_Test (&aReq[j], &flag, &aStatus[j]); } } - + break; - + case 5: /* use MPI_Testall */ flag = 0; while (!flag) { MPI_Testall (NUM_SEND_TYPES * 2, aReq, &flag, aStatus); } - + break; - + case 6: /* use MPI_Testany */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { @@ -341,9 +341,9 @@ main (int argc, char **argv) &index, &flag, aStatus); } } - + break; - + case 7: /* use MPI_Testsome */ total = 0; @@ -354,12 +354,12 @@ main (int argc, char **argv) MPI_Testsome (NUM_SEND_TYPES * 2, aReq, &outcount, indices, aStatus); } - + total += outcount; } - + break; - + default: assert (0); break; diff --git a/teshsuite/smpi/isp/umpire/partial-recv-persistent4.c b/teshsuite/smpi/isp/umpire/partial-recv-persistent4.c index 44295dd9c5..c6216055b7 100644 --- a/teshsuite/smpi/isp/umpire/partial-recv-persistent4.c +++ b/teshsuite/smpi/isp/umpire/partial-recv-persistent4.c @@ -83,7 +83,7 @@ main (int argc, char **argv) /* use MPI_Test */ for (j = 0; j < 2; j++) { flag = 0; - + while (!flag) { MPI_Test (&aReq[j], &flag, &aStatus[j]); } diff --git a/teshsuite/smpi/isp/umpire/partial-recv.c b/teshsuite/smpi/isp/umpire/partial-recv.c index ae43cf8d9d..7ab0c557e9 100644 --- a/teshsuite/smpi/isp/umpire/partial-recv.c +++ b/teshsuite/smpi/isp/umpire/partial-recv.c @@ -100,13 +100,13 @@ main (int argc, char **argv) small_struct_buf[i].the_double = 1.0; small_struct_buf[i].the_char = 'a'; } - + for (i = 0; i < BIG_SIZE; i++) { big_struct_buf[i].the_double = 1.0; big_struct_buf[i].the_char = 'a'; big_struct_buf[i].the_other_double = 1.0; } - + /* set up the sends */ MPI_Isend (small_struct_buf, 1, newtype[0], 1, 0, comm, &aReq[0]); MPI_Isend (big_struct_buf, 1, newtype[1], 1, 1, comm, &aReq[1]); diff --git a/teshsuite/smpi/isp/umpire/pt2pt-byte-int-mismatch.c b/teshsuite/smpi/isp/umpire/pt2pt-byte-int-mismatch.c index 8ff6b91622..12805a00f1 100644 --- a/teshsuite/smpi/isp/umpire/pt2pt-byte-int-mismatch.c +++ b/teshsuite/smpi/isp/umpire/pt2pt-byte-int-mismatch.c @@ -124,7 +124,7 @@ main (int argc, char **argv) comm, &aReq[send_t_number * 2 + 1]); send_t_number++; - + MPI_Ibsend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT, 1, send_t_number * 2, comm, &aReq[send_t_number * 2]); MPI_Ibsend (&buf[(send_t_number * 2 + 1) * BUF_SIZE], @@ -135,7 +135,7 @@ main (int argc, char **argv) /* Barrier to ensure receives are posted for rsends... */ MPI_Barrier(MPI_COMM_WORLD); - + MPI_Irsend (&buf[send_t_number * 2 * BUF_SIZE], BUF_SIZE, MPI_INT, 1, send_t_number * 2, comm, &aReq[send_t_number * 2]); MPI_Irsend (&buf[(send_t_number * 2 + 1) * BUF_SIZE], @@ -165,7 +165,7 @@ main (int argc, char **argv) MPI_Start (&aReq[2 * send_t_number + j]); } } - + /* complete the sends */ switch (k/2) { case 0: @@ -174,7 +174,7 @@ main (int argc, char **argv) MPI_Wait (&aReq[j], &aStatus[j]); } break; - + case 1: /* use MPI_Waitall */ MPI_Waitall (NUM_SEND_TYPES * 2, aReq, aStatus); @@ -185,9 +185,9 @@ main (int argc, char **argv) for (j = 0; j < NUM_SEND_TYPES * 2; j++) { MPI_Waitany (NUM_SEND_TYPES * 2, aReq, &index, aStatus); } - + break; - + case 3: /* use MPI_Waitsome */ total = 0; @@ -204,23 +204,23 @@ main (int argc, char **argv) /* use MPI_Test */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { flag = 0; - + while (!flag) { MPI_Test (&aReq[j], &flag, &aStatus[j]); } } - + break; - + case 5: /* use MPI_Testall */ flag = 0; while (!flag) { MPI_Testall (NUM_SEND_TYPES * 2, aReq, &flag, aStatus); } - + break; - + case 6: /* use MPI_Testany */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { @@ -232,7 +232,7 @@ main (int argc, char **argv) } break; - + case 7: /* use MPI_Testsome */ total = 0; @@ -279,7 +279,7 @@ main (int argc, char **argv) /* Barrier to ensure receives are posted for rsends... */ MPI_Barrier(MPI_COMM_WORLD); - + /* complete all of the receives... */ switch (l/2) { case 0: @@ -288,7 +288,7 @@ main (int argc, char **argv) MPI_Wait (&aReq[j], &aStatus[j]); } break; - + case 1: /* use MPI_Waitall */ MPI_Waitall (NUM_SEND_TYPES * 2, aReq, aStatus); @@ -299,9 +299,9 @@ main (int argc, char **argv) for (j = 0; j < NUM_SEND_TYPES * 2; j++) { MPI_Waitany (NUM_SEND_TYPES * 2, aReq, &index, aStatus); } - + break; - + case 3: /* use MPI_Waitsome */ total = 0; @@ -313,28 +313,28 @@ main (int argc, char **argv) } break; - + case 4: /* use MPI_Test */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { flag = 0; - + while (!flag) { MPI_Test (&aReq[j], &flag, &aStatus[j]); } } - + break; - + case 5: /* use MPI_Testall */ flag = 0; while (!flag) { MPI_Testall (NUM_SEND_TYPES * 2, aReq, &flag, aStatus); } - + break; - + case 6: /* use MPI_Testany */ for (j = 0; j < NUM_SEND_TYPES * 2; j++) { @@ -344,9 +344,9 @@ main (int argc, char **argv) &index, &flag, aStatus); } } - + break; - + case 7: /* use MPI_Testsome */ total = 0; @@ -357,12 +357,12 @@ main (int argc, char **argv) MPI_Testsome (NUM_SEND_TYPES * 2, aReq, &outcount, indices, aStatus); } - + total += outcount; } - + break; - + default: assert (0); break; diff --git a/teshsuite/smpi/isp/umpire/type-no-error-exhaustive-with-isends.c b/teshsuite/smpi/isp/umpire/type-no-error-exhaustive-with-isends.c index e0525a6293..4e93bc36aa 100644 --- a/teshsuite/smpi/isp/umpire/type-no-error-exhaustive-with-isends.c +++ b/teshsuite/smpi/isp/umpire/type-no-error-exhaustive-with-isends.c @@ -215,7 +215,7 @@ main (int argc, char **argv) struct_lb_ub_send_buf[i].dontsend_double2 = 1.0; #endif } - + /* set up the sends */ #ifdef RUN_TYPE_STRUCT MPI_Isend (struct_buf, MSG_COUNT, newtype[0], 1, 0, comm, &aReq[0]); @@ -692,7 +692,7 @@ main (int argc, char **argv) #endif } } - + if ((rank == 0) || (rank == 1)) { /* wait on everything... */ MPI_Waitall (TYPE_CONSTRUCTOR_COUNT, aReq, aStatus); @@ -1032,7 +1032,7 @@ main (int argc, char **argv) #endif } } - + for (i = 0; i < TYPE_CONSTRUCTOR_COUNT; i++) { MPI_Type_free (&newtype[i]); } diff --git a/teshsuite/smpi/isp/umpire/waitany-deadlock.c b/teshsuite/smpi/isp/umpire/waitany-deadlock.c index 403ffb1184..2d0d0fc06d 100644 --- a/teshsuite/smpi/isp/umpire/waitany-deadlock.c +++ b/teshsuite/smpi/isp/umpire/waitany-deadlock.c @@ -58,7 +58,7 @@ main (int argc, char **argv) for (i = 3; i > 0; i--) { MPI_Recv (&flipbit, 1, MPI_INT, 0, i, MPI_COMM_WORLD, &status); - + MPI_Send (buf0, buf_size, MPI_INT, 0, 0, MPI_COMM_WORLD); } } diff --git a/teshsuite/smpi/mpich3-test/README b/teshsuite/smpi/mpich3-test/README index 7b81d594f3..206c950db1 100644 --- a/teshsuite/smpi/mpich3-test/README +++ b/teshsuite/smpi/mpich3-test/README @@ -1,7 +1,7 @@ MPICH Test Suite This test suite is a *supplement* to other test suites, including the -original MPICH testsuite, the Intel testsuite, and the IBM MPI test suite +original MPICH testsuite, the Intel testsuite, and the IBM MPI test suite (or test suites derived from that test, including the MPI C++ tests). Building the Test Suite @@ -13,8 +13,8 @@ For IBM MPI, where the compilation commands are not mpicc and mpif77 etc.: ./configure CC=xlc MPICC=mpcc F77=xlf MPIF77=mpxlf CXX=xlC \ MPICXX="mpCC -cpp" F90=xlf90 MPIF90=mpxlf90 \ - --disable-spawn \ - --enable-strictmpi + --disable-spawn \ + --enable-strictmpi (or the _r versions of the compilers) @@ -22,7 +22,7 @@ If mpicc and friends are not in your default path (and you do not want to add them), you can specify the path with --with-mpi=. For example, if they are in /usr/local/mympi/bin, use -./configure --with-mpi=/usr/local/mympi +./configure --with-mpi=/usr/local/mympi (configure will append the bin to the path that you give). @@ -32,7 +32,7 @@ The option "-cpp" is needed for at least some versions of mpCC to define the C++ bindings of the MPI routines. For implementations that do not implement all of MPI-2, there are --disable -options, including --disable-spawn and --disable-cxx. To restrict tests to +options, including --disable-spawn and --disable-cxx. To restrict tests to just what is defined in the MPI specification, use --enable-strictmpi . The script that runs the tests assumes that the MPI implementation @@ -46,18 +46,18 @@ MPITEST_DEBUG - if set, output information for debugging the test suite MPITEST_VERBOSE - if set to an integer value, output messages whose level is at least that value (0 is a good choice here) MPITEST_RETURN_WITH_CODE - Set the return code from the test programs based on - success or failure, with a zero for success and one - for failure (value must be yes, YES, true, or TRUE to - turn this on) -MPITEST_THREADLEVEL_DEFAULT - Set the default thread level. Values are - multiple, serialized, funneled, and single. + success or failure, with a zero for success and one + for failure (value must be yes, YES, true, or TRUE to + turn this on) +MPITEST_THREADLEVEL_DEFAULT - Set the default thread level. Values are + multiple, serialized, funneled, and single. Batch Systems ============= For systems that run applications through a batch system, the option "-batch" -to the runtests script will create a script file that can be edited and -submitted to the batch system. The script checktests can be run to -summarize the results. +to the runtests script will create a script file that can be edited and +submitted to the batch system. The script checktests can be run to +summarize the results. Specifically, (assuming the bash shell, and that the directory "btest", a subdirectory of the test suite directory, is used for running the tests): @@ -66,7 +66,7 @@ export MPITEST_BATCHDIR=`pwd`/btest runtests -batch -tests=testlist ... edit btest/runtests.batch to make it a value batch submissions script ... run that script and wait for the batch job to complete -cd btest && ../checktests +cd btest && ../checktests If a program other than mpiexec is used in the batch form to run programs, then specify that to runtests: @@ -75,20 +75,20 @@ specify that to runtests: (Here, aprun is the command used on Cray XE6 systems.) -Note that some programs that are used to run MPI programs add extra output, +Note that some programs that are used to run MPI programs add extra output, which can confuse any tool that depends on clean output in STDOUT. Since -such unfortunate behavior is common, the option -ignorebogus can be given +such unfortunate behavior is common, the option -ignorebogus can be given to checktests: cd btest && ../checktests --ignorebogus Controlling the Tests that are Run ================================== -The tests are actually built and run by the script "runtests". This script +The tests are actually built and run by the script "runtests". This script can be given a file that contains a list of the tests to run. This file has two primary types of entries: - directories: Enter directory and look for the file "testlist". + directories: Enter directory and look for the file "testlist". Recursively run the contents of that file program names: Build and run that program @@ -100,8 +100,8 @@ program sendrecv1 and run it with 4 processes: sendrecv1 4 -In addition, the program line can contain key=value pairs that provide -special information about running the test. For example, +In addition, the program line can contain key=value pairs that provide +special information about running the test. For example, sendflood 8 timeLimit=600 @@ -127,29 +127,27 @@ mpiexecarg=string : Run the program with string as an argument to mpiexec env=name=value : Run the program with environment variable "name" given the value "value" -mpiversion=x.y : Build and run the program only if the MPI version is at - least x.y. For example, +mpiversion=x.y : Build and run the program only if the MPI version is at + least x.y. For example, distgraph1 4 mpiversion=2.2 - will build and run distgraph1 with 4 MPI processes only - if the MPI version is at least 2.2. + will build and run distgraph1 with 4 MPI processes only + if the MPI version is at least 2.2. -strict=bool : If bool is false, only build and run the program if +strict=bool : If bool is false, only build and run the program if --enable-strictmpi was not used in configuring the test suite. - That is, a line such as + That is, a line such as neighb_coll 4 strict=false Says that this test is not valid for a strict MPI implementation; it contains extensions to the standard, or in the case of some - MPICH development, MPIX routines + MPICH development, MPIX routines -resultTest=proc : This is used to change the way in which the success or - failure of a test is evaluated. proc is one of several +resultTest=proc : This is used to change the way in which the success or + failure of a test is evaluated. proc is one of several Perl subroutines defined within the runtest program. These are primarily used within the testsuite for tests programs - exit with expected status values or that timeouts are + exit with expected status values or that timeouts are in fact handled. - - diff --git a/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f b/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f index 44e5b5e3e1..93d6709012 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/attrmpi1f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -19,7 +19,7 @@ C C Simple attribute put and get C call mpi_keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, - $ mykey, extra,ierr ) + $ mykey, extra,ierr ) call mpi_attr_get( MPI_COMM_WORLD, mykey, value, flag, ierr ) if (flag) then errs = errs + 1 @@ -55,7 +55,7 @@ C print *, "Neg Attribute value ", rvalue," should be ",svalue endif endif -C +C call mpi_keyval_free( mykey, ierr ) call mtest_finalize( errs ) call mpi_finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f77/attr/baseattr2f.f b/teshsuite/smpi/mpich3-test/f77/attr/baseattr2f.f index 59d69bc94c..8bf8286245 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/baseattr2f.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/baseattr2f.f @@ -18,14 +18,14 @@ C call mpi_comm_rank( MPI_COMM_WORLD, commrank, ierr ) call mpi_attr_get( MPI_COMM_WORLD, MPI_TAG_UB, value, flag, ierr - $ ) + $ ) if (.not. flag) then errs = errs + 1 print *, "Could not get TAG_UB" else if (value .lt. 32767) then errs = errs + 1 - print *, "Got too-small value (", value, ") for TAG_UB" + print *, "Got too-small value (", value, ") for TAG_UB" endif endif @@ -33,13 +33,13 @@ C if (.not. flag) then errs = errs + 1 print *, "Could not get HOST" - else + else if ((value .lt. 0 .or. value .ge. commsize) .and. value .ne. - $ MPI_PROC_NULL) then + $ MPI_PROC_NULL) then errs = errs + 1 print *, "Got invalid value ", value, " for HOST" endif - endif + endif call mpi_attr_get( MPI_COMM_WORLD, MPI_IO, value, flag, ierr ) if (.not. flag) then @@ -57,10 +57,10 @@ C $ flag, ierr ) if (flag) then C Wtime need not be set - if (value .lt. 0 .or. value .gt. 1) then + if (value .lt. 0 .or. value .gt. 1) then errs = errs + 1 print *, "Invalid value for WTIME_IS_GLOBAL (got ", value, - $ ")" + $ ")" endif endif @@ -71,7 +71,7 @@ C appnum need not be set if (value .lt. 0) then errs = errs + 1 print *, "MPI_APPNUM is defined as ", value, - $ " but must be nonnegative" + $ " but must be nonnegative" endif endif @@ -85,7 +85,7 @@ C MPI_UNIVERSE_SIZE need not be set $ ", less than comm world (", commsize, ")" endif endif - + call mpi_attr_get( MPI_COMM_WORLD, MPI_LASTUSEDCODE, value, flag $ , ierr ) C Last used code must be defined and >= MPI_ERR_LASTCODE @@ -96,7 +96,7 @@ C Last used code must be defined and >= MPI_ERR_LASTCODE $ MPI_ERR_LASTCODE, ") smaller than MPI_ERR_LASTCODE (", $ value, ")" endif - else + else errs = errs + 1 print *, "MPI_LASTUSECODE is not defined" endif diff --git a/teshsuite/smpi/mpich3-test/f77/attr/baseattrf.f b/teshsuite/smpi/mpich3-test/f77/attr/baseattrf.f index 36f520d855..62d55b56dc 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/baseattrf.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/baseattrf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -27,7 +27,7 @@ C call mpi_attr_get( MPI_COMM_WORLD, MPI_LASTUSEDCODE, value, flag, $ ierr ) - ! Last used code must be defined and >= MPI_ERR_LASTCODE + ! Last used code must be defined and >= MPI_ERR_LASTCODE if (flag) then if (value .lt. MPI_ERR_LASTCODE) then errs = errs + 1 @@ -35,7 +35,7 @@ C $ (", value, ") smaller than MPI_ERR_LASTCODE (", $ MPI_ERR_LASTCODE, ")" endif - else + else errs = errs + 1 print *, "MPI_LASTUSECODE is not defined" endif diff --git a/teshsuite/smpi/mpich3-test/f77/attr/commattr2f.f b/teshsuite/smpi/mpich3-test/f77/attr/commattr2f.f index 92d47f9343..3b1b6767da 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/commattr2f.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/commattr2f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,15 +17,15 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 call mtest_init( ierr ) call mpi_comm_dup( MPI_COMM_WORLD, comm1, ierr ) -C +C extrastate = 1001 - call mpi_comm_create_keyval( MPI_COMM_DUP_FN, - & MPI_COMM_NULL_DELETE_FN, keyval, + call mpi_comm_create_keyval( MPI_COMM_DUP_FN, + & MPI_COMM_NULL_DELETE_FN, keyval, & extrastate, ierr ) flag = .true. call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) @@ -41,10 +41,10 @@ C call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) if (valout .ne. 2003) then errs = errs + 1 - print *, 'Unexpected value (should be 2003)', valout, + print *, 'Unexpected value (should be 2003)', valout, & ' from attr' endif - + valin = 2001 call mpi_comm_set_attr( comm1, keyval, valin, ierr ) flag = .false. @@ -52,10 +52,10 @@ C call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) if (valout .ne. 2001) then errs = errs + 1 - print *, 'Unexpected value (should be 2001)', valout, + print *, 'Unexpected value (should be 2001)', valout, & ' from attr' endif - + C C Test the copy function valin = 5001 @@ -73,7 +73,7 @@ C Test the copy function errs = errs + 1 print *, 'Unexpected output value in comm2 ', valout endif -C Test the delete function +C Test the delete function call mpi_comm_free( comm2, ierr ) C C Test the attr delete function diff --git a/teshsuite/smpi/mpich3-test/f77/attr/commattr3f.f b/teshsuite/smpi/mpich3-test/f77/attr/commattr3f.f index cfa5ffb203..933415259b 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/commattr3f.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/commattr3f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2004 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -19,15 +19,15 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 call mtest_init( ierr ) call mpi_comm_dup( MPI_COMM_WORLD, comm1, ierr ) -C +C extrastate = 1001 - call mpi_comm_create_keyval( MPI_COMM_NULL_COPY_FN, - & MPI_COMM_NULL_DELETE_FN, keyval, + call mpi_comm_create_keyval( MPI_COMM_NULL_COPY_FN, + & MPI_COMM_NULL_DELETE_FN, keyval, & extrastate, ierr ) flag = .true. call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) @@ -40,7 +40,7 @@ C Test the null copy function valin = 5001 call mpi_comm_set_attr( comm1, keyval, valin, ierr ) call mpi_comm_dup( comm1, comm2, ierr ) -C Because we set NULL_COPY_FN, the attribute should not +C Because we set NULL_COPY_FN, the attribute should not C appear on the dup'ed communicator flag = .false. call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) @@ -54,7 +54,7 @@ C appear on the dup'ed communicator errs = errs + 1 print *, ' Attribute incorrectly present on dup communicator' endif -C Test the delete function +C Test the delete function call mpi_comm_free( comm2, ierr ) C C Test the attr delete function diff --git a/teshsuite/smpi/mpich3-test/f77/attr/commattrf.f b/teshsuite/smpi/mpich3-test/f77/attr/commattrf.f index 491ec88098..0b9e2a1c21 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/commattrf.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/commattrf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -18,16 +18,16 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 callcount = 0 delcount = 0 call mtest_init( ierr ) call mpi_comm_dup( MPI_COMM_WORLD, comm1, ierr ) -C +C extrastate = 1001 - call mpi_comm_create_keyval( mycopyfn, mydelfn, keyval, + call mpi_comm_create_keyval( mycopyfn, mydelfn, keyval, & extrastate, ierr ) flag = .true. call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) @@ -43,10 +43,10 @@ C call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) if (valout .ne. 2003) then errs = errs + 1 - print *, 'Unexpected value (should be 2003)', valout, + print *, 'Unexpected value (should be 2003)', valout, & ' from attr' endif - + valin = 2001 call mpi_comm_set_attr( comm1, keyval, valin, ierr ) flag = .false. @@ -54,10 +54,10 @@ C call mpi_comm_get_attr( comm1, keyval, valout, flag, ierr ) if (valout .ne. 2001) then errs = errs + 1 - print *, 'Unexpected value (should be 2001)', valout, + print *, 'Unexpected value (should be 2001)', valout, & ' from attr' endif - + C C Test the copy function valin = 5001 @@ -75,12 +75,12 @@ C Test the copy function errs = errs + 1 print *, 'Unexpected output value in comm2 ', valout endif -C Test the delete function +C Test the delete function curcount = delcount call mpi_comm_free( comm2, ierr ) if (delcount .ne. curcount + 1) then errs = errs + 1 - print *, ' did not get expected value of delcount ', + print *, ' did not get expected value of delcount ', & delcount, curcount + 1 endif C diff --git a/teshsuite/smpi/mpich3-test/f77/attr/typeattr2f.f b/teshsuite/smpi/mpich3-test/f77/attr/typeattr2f.f index c0ce987b7f..7918b455a5 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/typeattr2f.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/typeattr2f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,15 +17,15 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 call mtest_init( ierr ) type1 = MPI_INTEGER -C +C extrastate = 1001 - call mpi_type_create_keyval( MPI_TYPE_DUP_FN, - & MPI_TYPE_NULL_DELETE_FN, keyval, + call mpi_type_create_keyval( MPI_TYPE_DUP_FN, + & MPI_TYPE_NULL_DELETE_FN, keyval, & extrastate, ierr ) flag = .true. call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) @@ -41,10 +41,10 @@ C call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) if (valout .ne. 2003) then errs = errs + 1 - print *, 'Unexpected value (should be 2003)', valout, + print *, 'Unexpected value (should be 2003)', valout, & ' from attr' endif - + valin = 2001 call mpi_type_set_attr( type1, keyval, valin, ierr ) flag = .false. @@ -52,10 +52,10 @@ C call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) if (valout .ne. 2001) then errs = errs + 1 - print *, 'Unexpected value (should be 2001)', valout, + print *, 'Unexpected value (should be 2001)', valout, & ' from attr' endif - + C C Test the copy function valin = 5001 @@ -73,7 +73,7 @@ C Test the copy function errs = errs + 1 print *, 'Unexpected output value in type2 ', valout endif -C Test the delete function +C Test the delete function call mpi_type_free( type2, ierr ) C C Test the attr delete function diff --git a/teshsuite/smpi/mpich3-test/f77/attr/typeattr3f.f b/teshsuite/smpi/mpich3-test/f77/attr/typeattr3f.f index 36fcc3b422..0282f41147 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/typeattr3f.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/typeattr3f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2004 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -19,15 +19,15 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 call mtest_init( ierr ) type1 = MPI_INTEGER -C +C extrastate = 1001 - call mpi_type_create_keyval( MPI_TYPE_NULL_COPY_FN, - & MPI_TYPE_NULL_DELETE_FN, keyval, + call mpi_type_create_keyval( MPI_TYPE_NULL_COPY_FN, + & MPI_TYPE_NULL_DELETE_FN, keyval, & extrastate, ierr ) flag = .true. call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) @@ -40,7 +40,7 @@ C Test the null copy function valin = 5001 call mpi_type_set_attr( type1, keyval, valin, ierr ) call mpi_type_dup( type1, type2, ierr ) -C Because we set NULL_COPY_FN, the attribute should not +C Because we set NULL_COPY_FN, the attribute should not C appear on the dup'ed communicator flag = .false. call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) @@ -54,7 +54,7 @@ C appear on the dup'ed communicator errs = errs + 1 print *, ' Attribute incorrectly present on dup datatype' endif -C Test the delete function +C Test the delete function call mpi_type_free( type2, ierr ) C C Test the attr delete function diff --git a/teshsuite/smpi/mpich3-test/f77/attr/typeattrf.f b/teshsuite/smpi/mpich3-test/f77/attr/typeattrf.f index f9f4ce5fdb..f525e4ff08 100644 --- a/teshsuite/smpi/mpich3-test/f77/attr/typeattrf.f +++ b/teshsuite/smpi/mpich3-test/f77/attr/typeattrf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -19,17 +19,17 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 callcount = 0 delcount = 0 call mtest_init( ierr ) -C +C C Attach an attribute to a predefined object type1 = MPI_INTEGER extrastate = 1001 - call mpi_type_create_keyval( mycopyfn, mydelfn, keyval, + call mpi_type_create_keyval( mycopyfn, mydelfn, keyval, & extrastate, ierr ) flag = .true. call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) @@ -45,10 +45,10 @@ C Attach an attribute to a predefined object call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) if (valout .ne. 2003) then errs = errs + 1 - print *, 'Unexpected value (should be 2003)', valout, + print *, 'Unexpected value (should be 2003)', valout, & ' from attr' endif - + valin = 2001 call mpi_type_set_attr( type1, keyval, valin, ierr ) flag = .false. @@ -56,10 +56,10 @@ C Attach an attribute to a predefined object call mpi_type_get_attr( type1, keyval, valout, flag, ierr ) if (valout .ne. 2001) then errs = errs + 1 - print *, 'Unexpected value (should be 2001)', valout, + print *, 'Unexpected value (should be 2001)', valout, & ' from attr' endif - + C C Test the copy function valin = 5001 @@ -77,12 +77,12 @@ C Test the copy function errs = errs + 1 print *, 'Unexpected output value in type2 ', valout endif -C Test the delete function +C Test the delete function curcount = delcount call mpi_type_free( type2, ierr ) if (delcount .ne. curcount + 1) then errs = errs + 1 - print *, ' did not get expected value of delcount ', + print *, ' did not get expected value of delcount ', & delcount, curcount + 1 endif C diff --git a/teshsuite/smpi/mpich3-test/f77/coll/allredint8f.f b/teshsuite/smpi/mpich3-test/f77/coll/allredint8f.f index 10ece8700e..0dd82aabd1 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/allredint8f.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/allredint8f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2006 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -10,14 +10,14 @@ C integer errs, ierr errs = 0 - + call mtest_init( ierr ) C C A simple test of allreduce for the optional integer*8 type - call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM, + call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM, & MPI_COMM_WORLD, ierr) - + call mtest_finalize( errs ) call mpi_finalize( ierr ) end diff --git a/teshsuite/smpi/mpich3-test/f77/coll/allredopttf.f b/teshsuite/smpi/mpich3-test/f77/coll/allredopttf.f index 1b71c8d2a7..74add9f8a1 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/allredopttf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/allredopttf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2007 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -12,7 +12,7 @@ C integer errs, ierr errs = 0 - + call mtest_init( ierr ) call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr ) C @@ -20,25 +20,25 @@ C A simple test of allreduce for the optional integer*8 type inbuf = 1 outbuf = 0 - call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM, + call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM, & MPI_COMM_WORLD, ierr) if (outbuf .ne. wsize ) then errs = errs + 1 - print *, "result wrong for sum with integer*8 = got ", outbuf, + print *, "result wrong for sum with integer*8 = got ", outbuf, & " but should have ", wsize endif zinbuf = (1,1) zoutbuf = (0,0) - call mpi_allreduce(zinbuf, zoutbuf, 1, MPI_DOUBLE_COMPLEX, + call mpi_allreduce(zinbuf, zoutbuf, 1, MPI_DOUBLE_COMPLEX, & MPI_SUM, MPI_COMM_WORLD, ierr) if (dreal(zoutbuf) .ne. wsize ) then errs = errs + 1 - print *, "result wrong for sum with double complex = got ", + print *, "result wrong for sum with double complex = got ", & outbuf, " but should have ", wsize endif if (dimag(zoutbuf) .ne. wsize ) then errs = errs + 1 - print *, "result wrong for sum with double complex = got ", + print *, "result wrong for sum with double complex = got ", & outbuf, " but should have ", wsize endif call mtest_finalize( errs ) diff --git a/teshsuite/smpi/mpich3-test/f77/coll/alltoallvf.f b/teshsuite/smpi/mpich3-test/f77/coll/alltoallvf.f index 0a2831a1f6..d2be415543 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/alltoallvf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/alltoallvf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2011 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -15,7 +15,7 @@ C integer sbuf(maxSize), rbuf(maxSize) errs = 0 - + call mtest_init( ierr ) C Get a comm @@ -31,7 +31,7 @@ C Get a comm call mpi_comm_size( comm, size, ierr ) endif call mpi_comm_rank( comm, rank, ierr ) -C +C if (size .le. maxSize) then C Initialize the data. Just use this as an all to all C Use the same test as alltoallwf.c , except displacements are in units of @@ -47,15 +47,15 @@ C integers instead of bytes rbuf(i) = -1 enddo call mpi_alltoallv( sbuf, scounts, sdispls, stypes, - & rbuf, rcounts, rdispls, rtypes, comm, ierr ) + & rbuf, rcounts, rdispls, rtypes, comm, ierr ) C C check rbuf(i) = data from the ith location of the ith send buf, or -C rbuf(i) = (i-1) * size + i +C rbuf(i) = (i-1) * size + i do i=1, size ans = (i-1) * size + rank + 1 if (rbuf(i) .ne. ans) then errs = errs + 1 - print *, rank, ' rbuf(', i, ') = ', rbuf(i), + print *, rank, ' rbuf(', i, ') = ', rbuf(i), & ' expected ', ans endif enddo @@ -91,7 +91,7 @@ C Note that the arrays are 1-origin sbuf(1+displ) = rank displ = displ + 1 if (rank .lt. size-1) then - scounts(1+rank+1) = 1 + scounts(1+rank+1) = 1 rcounts(1+rank+1) = 1 sdispls(1+rank+1) = displ rdispls(1+rank+1) = rank+1 @@ -126,14 +126,14 @@ C do i=0,rank-2 if (rbuf(1+i) .ne. -1) then errs = errs + 1 - print *, rank, ' rbuf(', 1+i, ') = ', rbuf(1+i), + print *, rank, ' rbuf(', 1+i, ') = ', rbuf(1+i), & 'expected -1' endif enddo do i=rank+2,size-1 if (rbuf(1+i) .ne. -1) then errs = errs + 1 - print *, rank, ' rbuf(', i, ') = ', rbuf(1+i), + print *, rank, ' rbuf(', i, ') = ', rbuf(1+i), & 'expected -1' endif enddo @@ -143,4 +143,4 @@ C call mtest_finalize( errs ) call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f77/coll/alltoallwf.f b/teshsuite/smpi/mpich3-test/f77/coll/alltoallwf.f index 7ab0d60f57..03bcbf5d23 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/alltoallwf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/alltoallwf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -14,7 +14,7 @@ C integer rcounts(maxSize), rdispls(maxSize), rtypes(maxSize) integer sbuf(maxSize), rbuf(maxSize) errs = 0 - + call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) @@ -32,7 +32,7 @@ C Get a comm call mpi_comm_size( comm, size, ierr ) endif call mpi_comm_rank( comm, rank, ierr ) - + if (size .le. maxSize) then C Initialize the data. Just use this as an all to all do i=1, size @@ -46,15 +46,15 @@ C Initialize the data. Just use this as an all to all rbuf(i) = -1 enddo call mpi_alltoallw( sbuf, scounts, sdispls, stypes, - & rbuf, rcounts, rdispls, rtypes, comm, ierr ) + & rbuf, rcounts, rdispls, rtypes, comm, ierr ) C C check rbuf(i) = data from the ith location of the ith send buf, or -C rbuf(i) = (i-1) * size + i +C rbuf(i) = (i-1) * size + i do i=1, size ans = (i-1) * size + rank + 1 if (rbuf(i) .ne. ans) then errs = errs + 1 - print *, rank, ' rbuf(', i, ') = ', rbuf(i), + print *, rank, ' rbuf(', i, ') = ', rbuf(i), & ' expected ', ans endif enddo @@ -64,4 +64,4 @@ C rbuf(i) = (i-1) * size + i call mtest_finalize( errs ) call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f77/coll/exscanf.f b/teshsuite/smpi/mpich3-test/f77/coll/exscanf.f index 27de6b97df..1bfe9ccd64 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/exscanf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/exscanf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -9,7 +9,7 @@ C integer cin(*), cout(*) integer count, datatype integer i - + if (.false.) then if (datatype .ne. MPI_INTEGER) then write(6,*) 'Invalid datatype passed to user_op()' @@ -32,7 +32,7 @@ C external uop errs = 0 - + call mtest_init( ierr ) C C A simple test of exscan @@ -43,7 +43,7 @@ C A simple test of exscan inbuf(1) = rank inbuf(2) = -rank - call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, MPI_SUM, comm, + call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, MPI_SUM, comm, & ierr ) C this process has the sum of i from 0 to rank-1, which is C (rank)(rank-1)/2 and -i @@ -59,12 +59,12 @@ C (rank)(rank-1)/2 and -i endif endif C -C Try a user-defined operation +C Try a user-defined operation C call mpi_op_create( uop, .true., sumop, ierr ) inbuf(1) = rank inbuf(2) = -rank - call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm, + call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm, & ierr ) C this process has the sum of i from 0 to rank-1, which is C (rank)(rank-1)/2 and -i @@ -80,14 +80,14 @@ C (rank)(rank-1)/2 and -i endif endif call mpi_op_free( sumop, ierr ) - + C C Try a user-defined operation (and don't claim it is commutative) C call mpi_op_create( uop, .false., sumop, ierr ) inbuf(1) = rank inbuf(2) = -rank - call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm, + call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm, & ierr ) C this process has the sum of i from 0 to rank-1, which is C (rank)(rank-1)/2 and -i @@ -103,7 +103,7 @@ C (rank)(rank-1)/2 and -i endif endif call mpi_op_free( sumop, ierr ) - + call mtest_finalize( errs ) call mpi_finalize( ierr ) end diff --git a/teshsuite/smpi/mpich3-test/f77/coll/inplacef.f b/teshsuite/smpi/mpich3-test/f77/coll/inplacef.f index 230cccb37a..69f46c6b16 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/inplacef.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/inplacef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2005 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -15,7 +15,7 @@ C integer MAX_SIZE parameter (MAX_SIZE=1024) integer rbuf(MAX_SIZE), rdispls(MAX_SIZE), rcount(MAX_SIZE), - $ sbuf(MAX_SIZE) + $ sbuf(MAX_SIZE) errs = 0 call mtest_init( ierr ) @@ -36,14 +36,14 @@ C Gather with inplace do i=1,size if (rbuf(i) .ne. i-1) then errs = errs + 1 - print *, '[',rank,'] rbuf(', i, ') = ', rbuf(i), - $ ' in gather' + print *, '[',rank,'] rbuf(', i, ') = ', rbuf(i), + $ ' in gather' endif enddo else call mpi_gather( rank, 1, MPI_INTEGER, rbuf, 1, MPI_INTEGER, $ root, comm, ierr ) - endif + endif C Gatherv with inplace do i=1,size @@ -58,14 +58,14 @@ C Gatherv with inplace do i=1,size if (rbuf(i) .ne. i-1) then errs = errs + 1 - print *, '[', rank, '] rbuf(', i, ') = ', rbuf(i), + print *, '[', rank, '] rbuf(', i, ') = ', rbuf(i), $ ' in gatherv' endif enddo else call mpi_gatherv( rank, 1, MPI_INTEGER, rbuf, rcount, rdispls, $ MPI_INTEGER, root, comm, ierr ) - endif + endif C Scatter with inplace do i=1,size @@ -81,9 +81,9 @@ C Scatter with inplace if (rbuf(1) .ne. rank+1) then errs = errs + 1 print *, '[', rank, '] rbuf = ', rbuf(1), - $ ' in scatter' + $ ' in scatter' endif - endif + endif call mtest_finalize( errs ) call mpi_finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f77/coll/nonblocking_inpf.f b/teshsuite/smpi/mpich3-test/f77/coll/nonblocking_inpf.f index d2c3bbd015..ca619aa771 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/nonblocking_inpf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/nonblocking_inpf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2012 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f77/coll/nonblockingf.f b/teshsuite/smpi/mpich3-test/f77/coll/nonblockingf.f index b2785bbbae..45d61eecf0 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/nonblockingf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/nonblockingf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2012 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -25,7 +25,7 @@ C comm = MPI_COMM_WORLD call MPI_Comm_size(comm, size, ierr) call MPI_Comm_rank(comm, rank, ierr) -C +C do ii = 1, size sbuf(2*ii-1) = ii sbuf(2*ii) = ii @@ -93,7 +93,7 @@ C . MPI_SUM, comm, req, ierr) call MPI_Wait(req, MPI_STATUS_IGNORE, ierr) - call MPI_Iscatter(sbuf, NUM_INTS, MPI_INTEGER, rbuf, + call MPI_Iscatter(sbuf, NUM_INTS, MPI_INTEGER, rbuf, . NUM_INTS, MPI_INTEGER, 0, comm, req, ierr) call MPI_Wait(req, MPI_STATUS_IGNORE, ierr) @@ -106,8 +106,8 @@ C . rbuf, NUM_INTS, MPI_INTEGER, comm, req, ierr) call MPI_Wait(req, MPI_STATUS_IGNORE, ierr) - call MPI_Iallgatherv(sbuf, NUM_INTS, MPI_INTEGER, - . rbuf, rcounts, rdispls, MPI_INTEGER, + call MPI_Iallgatherv(sbuf, NUM_INTS, MPI_INTEGER, + . rbuf, rcounts, rdispls, MPI_INTEGER, . comm, req, ierr) call MPI_Wait(req, MPI_STATUS_IGNORE, ierr) diff --git a/teshsuite/smpi/mpich3-test/f77/coll/red_scat_blockf.f b/teshsuite/smpi/mpich3-test/f77/coll/red_scat_blockf.f index 831f2fc7a4..ee97041f2e 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/red_scat_blockf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/red_scat_blockf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2012 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f77/coll/redscatf.f b/teshsuite/smpi/mpich3-test/f77/coll/redscatf.f index efd6c06040..e88b41ce1d 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/redscatf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/redscatf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2011 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -25,7 +25,7 @@ C C C Test of reduce scatter. C -C Each processor contributes its rank + the index to the reduction, +C Each processor contributes its rank + the index to the reduction, C then receives the ith sum C C Can be called with any number of processors. @@ -58,11 +58,11 @@ C recvcounts(i) = 1 enddo - call mpi_reduce_scatter( sendbuf, recvbuf, recvcounts, + call mpi_reduce_scatter( sendbuf, recvbuf, recvcounts, & MPI_INTEGER, MPI_SUM, comm, ierr ) sumval = size * rank + ((size - 1) * size)/2 -C recvbuf should be size * (rank + i) +C recvbuf should be size * (rank + i) if (recvbuf .ne. sumval) then errs = errs + 1 print *, "Did not get expected value for reduce scatter" @@ -70,11 +70,11 @@ C recvbuf should be size * (rank + i) endif call mpi_op_create( uop, .true., sumop, ierr ) - call mpi_reduce_scatter( sendbuf, recvbuf, recvcounts, + call mpi_reduce_scatter( sendbuf, recvbuf, recvcounts, & MPI_INTEGER, sumop, comm, ierr ) sumval = size * rank + ((size - 1) * size)/2 -C recvbuf should be size * (rank + i) +C recvbuf should be size * (rank + i) if (recvbuf .ne. sumval) then errs = errs + 1 print *, "sumop: Did not get expected value for reduce scatter" diff --git a/teshsuite/smpi/mpich3-test/f77/coll/reducelocalf.f b/teshsuite/smpi/mpich3-test/f77/coll/reducelocalf.f index 6037308f0d..66eecf2702 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/reducelocalf.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/reducelocalf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2009 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,7 +17,7 @@ C write(6,*) 'Invalid datatype passed to user_op()' return endif - + do ii=1, count outvec(ii) = invec(ii) * 2 + outvec(ii) enddo @@ -34,7 +34,7 @@ C integer ierr, errs integer count, myop integer ii - + errs = 0 call mtest_init(ierr) @@ -44,7 +44,7 @@ C do ii = 1,count vin(ii) = ii vout(ii) = ii - enddo + enddo call mpi_reduce_local( vin, vout, count, & MPI_INTEGER, MPI_SUM, ierr ) C Check if the result is correct @@ -55,7 +55,7 @@ C Check if the result is correct if ( vout(ii) .ne. 2*ii ) then errs = errs + 1 endif - enddo + enddo if ( count .gt. 0 ) then count = count + count else @@ -66,7 +66,7 @@ C Check if the result is correct call mpi_op_create( user_op, .false., myop, ierr ) count = 0 - do while (count .le. max_buf_size) + do while (count .le. max_buf_size) do ii = 1, count vin(ii) = ii vout(ii) = ii diff --git a/teshsuite/smpi/mpich3-test/f77/coll/uallreducef.f b/teshsuite/smpi/mpich3-test/f77/coll/uallreducef.f index 566d294b92..7303a57bb7 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/uallreducef.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/uallreducef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -12,7 +12,7 @@ C integer cin(*), cout(*) integer count, datatype integer i - + C if (datatype .ne. MPI_INTEGER) then C print *, 'Invalid datatype (',datatype,') passed to user_op()' C return @@ -30,7 +30,7 @@ C endif integer ierr, errs integer count, sumop, vin(65000), vout(65000), i, size integer comm - + errs = 0 call mtest_init(ierr) @@ -39,12 +39,12 @@ C endif comm = MPI_COMM_WORLD call mpi_comm_size( comm, size, ierr ) count = 1 - do while (count .lt. 65000) + do while (count .lt. 65000) do i=1, count vin(i) = i vout(i) = -1 enddo - call mpi_allreduce( vin, vout, count, MPI_INTEGER, sumop, + call mpi_allreduce( vin, vout, count, MPI_INTEGER, sumop, * comm, ierr ) C Check that all results are correct do i=1, count diff --git a/teshsuite/smpi/mpich3-test/f77/coll/vw_inplacef.f b/teshsuite/smpi/mpich3-test/f77/coll/vw_inplacef.f index 4ad1d4ac36..b50540befc 100644 --- a/teshsuite/smpi/mpich3-test/f77/coll/vw_inplacef.f +++ b/teshsuite/smpi/mpich3-test/f77/coll/vw_inplacef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2012 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f77/comm/commerrf.f b/teshsuite/smpi/mpich3-test/f77/comm/commerrf.f index e58337f29f..26a06d4b30 100644 --- a/teshsuite/smpi/mpich3-test/f77/comm/commerrf.f +++ b/teshsuite/smpi/mpich3-test/f77/comm/commerrf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -10,7 +10,7 @@ C character*(MPI_MAX_ERROR_STRING) errstring integer comm, rlen external myerrhanfunc -CF90 INTERFACE +CF90 INTERFACE CF90 SUBROUTINE myerrhanfunc(vv0,vv1) CF90 INTEGER vv0,vv1 CF90 END SUBROUTINE @@ -52,25 +52,25 @@ C We can free our error handler now call mpi_comm_call_errhandler( comm, newerrclass, ierr ) call mpi_comm_call_errhandler( comm, code(1), ierr ) call mpi_comm_call_errhandler( comm, code(2), ierr ) - + if (callcount .ne. 3) then errs = errs + 1 - print *, ' Expected 3 calls to error handler, found ', + print *, ' Expected 3 calls to error handler, found ', & callcount else if (codesSeen(1) .ne. newerrclass) then errs = errs + 1 - print *, 'Expected class ', newerrclass, ' got ', + print *, 'Expected class ', newerrclass, ' got ', & codesSeen(1) endif if (codesSeen(2) .ne. code(1)) then errs = errs + 1 - print *, 'Expected code ', code(1), ' got ', + print *, 'Expected code ', code(1), ' got ', & codesSeen(2) endif if (codesSeen(3) .ne. code(2)) then errs = errs + 1 - print *, 'Expected code ', code(2), ' got ', + print *, 'Expected code ', code(2), ' got ', & codesSeen(3) endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/comm/commnamef.f b/teshsuite/smpi/mpich3-test/f77/comm/commnamef.f index 4ff5caf6de..a58295d7a1 100644 --- a/teshsuite/smpi/mpich3-test/f77/comm/commnamef.f +++ b/teshsuite/smpi/mpich3-test/f77/comm/commnamef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -14,7 +14,7 @@ C errs = 0 call mtest_init( ierr ) - + C Test the predefined communicators do ln=1,MPI_MAX_OBJECT_NAME cname(ln:ln) = 'X' @@ -76,7 +76,7 @@ C Now test them all endif call MTestFreeComm( comm(i) ) enddo -C +C call mtest_finalize( errs ) call mpi_finalize( ierr ) end diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/allctypesf.f b/teshsuite/smpi/mpich3-test/f77/datatype/allctypesf.f index f4c5e3f2d5..ea6c0865e5 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/allctypesf.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/allctypesf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2004 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -8,7 +8,7 @@ C integer atype, ierr C call mtest_init(ierr) - call mpi_comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN, + call mpi_comm_set_errhandler( MPI_COMM_WORLD, MPI_ERRORS_RETURN, * ierr ) C C Check that all Ctypes are available in Fortran (MPI 2.1, p 483, line 46) @@ -30,15 +30,15 @@ C call checkdtype( MPI_LONG_DOUBLE, "MPI_LONG_DOUBLE", ierr ) endif if (MPI_LONG_LONG_INT .ne. MPI_DATATYPE_NULL) then - call checkdtype2( MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT", + call checkdtype2( MPI_LONG_LONG_INT, "MPI_LONG_LONG_INT", * "MPI_LONG_LONG", ierr ) endif if (MPI_UNSIGNED_LONG_LONG .ne. MPI_DATATYPE_NULL) then - call checkdtype( MPI_UNSIGNED_LONG_LONG, + call checkdtype( MPI_UNSIGNED_LONG_LONG, * "MPI_UNSIGNED_LONG_LONG", ierr ) endif if (MPI_LONG_LONG .ne. MPI_DATATYPE_NULL) then - call checkdtype2( MPI_LONG_LONG, "MPI_LONG_LONG", + call checkdtype2( MPI_LONG_LONG, "MPI_LONG_LONG", * "MPI_LONG_LONG_INT", ierr ) endif call checkdtype( MPI_PACKED, "MPI_PACKED", ierr ) @@ -58,7 +58,7 @@ C Check that all Ctypes are available in Fortran (MPI 2.2) C Note that because of implicit declarations in Fortran, this C code should compile even with pre MPI 2.2 implementations. C - if (MPI_VERSION .gt. 2 .or. (MPI_VERSION .eq. 2 .and. + if (MPI_VERSION .gt. 2 .or. (MPI_VERSION .eq. 2 .and. * MPI_SUBVERSION .ge. 2)) then call checkdtype( MPI_INT8_T, "MPI_INT8_T", ierr ) call checkdtype( MPI_INT16_T, "MPI_INT16_T", ierr ) @@ -72,15 +72,15 @@ C other C99 types call checkdtype( MPI_C_BOOL, "MPI_C_BOOL", ierr ) call checkdtype( MPI_C_FLOAT_COMPLEX, "MPI_C_FLOAT_COMPLEX", * ierr) - call checkdtype2( MPI_C_COMPLEX, "MPI_C_COMPLEX", + call checkdtype2( MPI_C_COMPLEX, "MPI_C_COMPLEX", * "MPI_C_FLOAT_COMPLEX", ierr ) - call checkdtype( MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX", + call checkdtype( MPI_C_DOUBLE_COMPLEX, "MPI_C_DOUBLE_COMPLEX", * ierr ) if (MPI_C_LONG_DOUBLE_COMPLEX .ne. MPI_DATATYPE_NULL) then - call checkdtype( MPI_C_LONG_DOUBLE_COMPLEX, + call checkdtype( MPI_C_LONG_DOUBLE_COMPLEX, * "MPI_C_LONG_DOUBLE_COMPLEX", ierr ) endif -C address/offset types +C address/offset types call checkdtype( MPI_AINT, "MPI_AINT", ierr ) call checkdtype( MPI_OFFSET, "MPI_OFFSET", ierr ) endif @@ -96,7 +96,7 @@ C Check name of datatype character *(*) name integer ir, rlen character *(MPI_MAX_OBJECT_NAME) outname -C +C outname = "" call MPI_TYPE_GET_NAME( intype, outname, rlen, ir ) if (ir .ne. MPI_SUCCESS) then @@ -109,7 +109,7 @@ C ierr = ierr + 1 endif endif - + return end C @@ -120,7 +120,7 @@ C Check name of datatype (allows alias) character *(*) name, name2 integer ir, rlen character *(MPI_MAX_OBJECT_NAME) outname -C +C outname = "" call MPI_TYPE_GET_NAME( intype, outname, rlen, ir ) if (ir .ne. MPI_SUCCESS) then @@ -133,6 +133,6 @@ C ierr = ierr + 1 endif endif - + return end diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/gaddressf.f b/teshsuite/smpi/mpich3-test/f77/datatype/gaddressf.f index 4dba0f2a04..68d44a0119 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/gaddressf.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/gaddressf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C C (C) 2003 by Argonne National Laboratory. diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/hindex1f.f b/teshsuite/smpi/mpich3-test/f77/datatype/hindex1f.f index 1a689ed629..392176b5c2 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/hindex1f.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/hindex1f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C C (C) 2011 by Argonne National Laboratory. @@ -14,19 +14,19 @@ C integer inbuf(bufsize), outbuf(bufsize), packbuf(bufsize) integer position, len, psize C -C Test for hindexed; -C +C Test for hindexed; +C errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - + do i=1, 10 displs(i) = (10-i)*intsize counts(i) = 1 enddo call mpi_type_hindexed( 10, counts, displs, MPI_INTEGER, dtype, - & ierr ) + & ierr ) call mpi_type_commit( dtype, ierr ) C call mpi_pack_size( 1, dtype, MPI_COMM_WORLD, psize, ierr ) @@ -45,7 +45,7 @@ C position = 0 call mpi_unpack( packbuf, len, position, outbuf, 10, $ MPI_INTEGER, MPI_COMM_WORLD, ierr ) -C +C do i=1, 10 if (outbuf(i) .ne. 11-i) then errs = errs + 1 diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/packef.f b/teshsuite/smpi/mpich3-test/f77/datatype/packef.f index f91e91f7a9..aa866f2988 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/packef.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/packef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -22,28 +22,28 @@ C call mpi_type_size( MPI_INTEGER, intsize, ierr ) pbufsize = 1000 * intsize - call mpi_pack_external_size( 'external32', 10, MPI_INTEGER, - & aint, ierr ) + call mpi_pack_external_size( 'external32', 10, MPI_INTEGER, + & aint, ierr ) if (aint .ne. 10 * 4) then errs = errs + 1 print *, 'Expected 40 for size of 10 external32 integers', & ', got ', aint endif - call mpi_pack_external_size( 'external32', 10, MPI_LOGICAL, - & aint, ierr ) + call mpi_pack_external_size( 'external32', 10, MPI_LOGICAL, + & aint, ierr ) if (aint .ne. 10 * 4) then errs = errs + 1 print *, 'Expected 40 for size of 10 external32 logicals', & ', got ', aint endif - call mpi_pack_external_size( 'external32', 10, MPI_CHARACTER, - & aint, ierr ) + call mpi_pack_external_size( 'external32', 10, MPI_CHARACTER, + & aint, ierr ) if (aint .ne. 10 * 1) then errs = errs + 1 print *, 'Expected 10 for size of 10 external32 characters', & ', got ', aint endif - + call mpi_pack_external_size( 'external32', 3, MPI_INTEGER2, & aint, ierr ) if (aint .ne. 3 * 2) then @@ -112,7 +112,7 @@ C aintv(1) = pbufsize aintv(2) = 0 aintv(3) = 0 -C One MPI implementation failed to increment the position; instead, +C One MPI implementation failed to increment the position; instead, C it set the value with the amount of data packed in this call C We use aintv(3) to detect and report this specific error call mpi_pack_external( 'external32', inbuf, insize, MPI_INTEGER, @@ -121,21 +121,21 @@ C We use aintv(3) to detect and report this specific error print *, ' Position decreased after pack of integer!' endif aintv(3) = aintv(2) - call mpi_pack_external( 'external32', rbuf, rsize, - & MPI_DOUBLE_PRECISION, packbuf, aintv(1), + call mpi_pack_external( 'external32', rbuf, rsize, + & MPI_DOUBLE_PRECISION, packbuf, aintv(1), & aintv(2), ierr ) if (aintv(2) .le. aintv(3)) then print *, ' Position decreased after pack of real!' endif aintv(3) = aintv(2) - call mpi_pack_external( 'external32', cbuf, csize, - & MPI_CHARACTER, packbuf, aintv(1), + call mpi_pack_external( 'external32', cbuf, csize, + & MPI_CHARACTER, packbuf, aintv(1), & aintv(2), ierr ) if (aintv(2) .le. aintv(3)) then print *, ' Position decreased after pack of character!' endif aintv(3) = aintv(2) - call mpi_pack_external( 'external32', inbuf2, insize2, + call mpi_pack_external( 'external32', inbuf2, insize2, & MPI_INTEGER, & packbuf, aintv(1), aintv(2), ierr ) if (aintv(2) .le. aintv(3)) then @@ -165,7 +165,7 @@ C do i=1, rsize if (routbuf(i) .ne. 1000.0 * i) then errs = errs + 1 - print *, 'routbuf(',i,') = ', routbuf(i), ' expected ', & + print *, 'routbuf(',i,') = ', routbuf(i), ' expected ', & & 1000.0 * i endif enddo diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/typecntsf.f b/teshsuite/smpi/mpich3-test/f77/datatype/typecntsf.f index 2bd194c9e4..66902bcf23 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/typecntsf.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/typecntsf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -10,7 +10,7 @@ C integer ntype1, ntype2 C C This is a very simple test that just tests that the contents/envelope -C routines can be called. This should be upgraded to test the new +C routines can be called. This should be upgraded to test the new C MPI-2 datatype routines (which use address-sized integers) C @@ -19,14 +19,14 @@ C call explore( MPI_INTEGER, MPI_COMBINER_NAMED, errs ) call explore( MPI_BYTE, MPI_COMBINER_NAMED, errs ) - call mpi_type_vector( 10, 1, 30, MPI_DOUBLE_PRECISION, ntype1, + call mpi_type_vector( 10, 1, 30, MPI_DOUBLE_PRECISION, ntype1, & ierr ) call explore( ntype1, MPI_COMBINER_VECTOR, errs ) call mpi_type_dup( ntype1, ntype2, ierr ) call explore( ntype2, MPI_COMBINER_DUP, errs ) call mpi_type_free( ntype2, ierr ) call mpi_type_free( ntype1, ierr ) - + C call mtest_finalize( errs ) call mpi_finalize( ierr ) @@ -47,7 +47,7 @@ C & combiner, ierr ) C if (combiner .ne. MPI_COMBINER_NAMED) then - call mpi_type_get_contents( dtype, + call mpi_type_get_contents( dtype, & max_nints, max_asizev, max_dtypes, & intv, aintv, dtypesv, ierr ) C @@ -86,6 +86,6 @@ C List all combiner types to check that they are defined in mpif.h errs = errs + 1 print *, ' Unknown combiner ', combiner endif - + return end diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/typem2f.f b/teshsuite/smpi/mpich3-test/f77/datatype/typem2f.f index 32e9af4330..39be113bad 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/typem2f.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/typem2f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -28,7 +28,7 @@ C C aintv(1) = 0 aintv(2) = 3 * intsize - call mpi_type_create_resized( MPI_INTEGER, aintv(1), aintv(2), + call mpi_type_create_resized( MPI_INTEGER, aintv(1), aintv(2), & type1, ierr ) call mpi_type_commit( type1, ierr ) aintv(1) = -1 @@ -59,12 +59,12 @@ C blocklens(i) = 1 aintv(i) = (i-1) * 3 * intsize enddo - call mpi_type_create_hindexed( 10, blocklens, aintv, + call mpi_type_create_hindexed( 10, blocklens, aintv, & MPI_INTEGER, type2, ierr ) call mpi_type_commit( type2, ierr ) C aint = 3 * intsize - call mpi_type_create_hvector( 10, 1, aint, MPI_INTEGER, type3, + call mpi_type_create_hvector( 10, 1, aint, MPI_INTEGER, type3, & ierr ) call mpi_type_commit( type3, ierr ) C @@ -80,7 +80,7 @@ C do i=1,10 displs(i) = (i-1) * 3 enddo - call mpi_type_create_indexed_block( 10, 1, displs, + call mpi_type_create_indexed_block( 10, 1, displs, & MPI_INTEGER, type5, ierr ) call mpi_type_commit( type5, ierr ) C @@ -91,8 +91,8 @@ C Using each time, send and receive using these types do i=1, max_asizev sendbuf(i) = i enddo - call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, - & recvbuf, max_asizev, type1, rank, 0, + call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, + & recvbuf, max_asizev, type1, rank, 0, & MPI_COMM_WORLD, status, ierr ) do i=1, max_asizev if (recvbuf(1+(i-1)*3) .ne. i ) then @@ -107,8 +107,8 @@ C do i=1, max_asizev sendbuf(i) = i enddo - call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, - & recvbuf, 1, type2, rank, 0, + call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, + & recvbuf, 1, type2, rank, 0, & MPI_COMM_WORLD, status, ierr ) do i=1, max_asizev if (recvbuf(1+(i-1)*3) .ne. i ) then @@ -123,8 +123,8 @@ C do i=1, max_asizev sendbuf(i) = i enddo - call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, - & recvbuf, 1, type3, rank, 0, + call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, + & recvbuf, 1, type3, rank, 0, & MPI_COMM_WORLD, status, ierr ) do i=1, max_asizev if (recvbuf(1+(i-1)*3) .ne. i ) then @@ -139,8 +139,8 @@ C do i=1, max_asizev sendbuf(i) = i enddo - call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, - & recvbuf, 1, type4, rank, 0, + call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, + & recvbuf, 1, type4, rank, 0, & MPI_COMM_WORLD, status, ierr ) do i=1, max_asizev if (recvbuf(1+(i-1)*3) .ne. i ) then @@ -155,8 +155,8 @@ C do i=1, max_asizev sendbuf(i) = i enddo - call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, - & recvbuf, 1, type5, rank, 0, + call mpi_sendrecv( sendbuf, max_asizev, MPI_INTEGER, rank, 0, + & recvbuf, 1, type5, rank, 0, & MPI_COMM_WORLD, status, ierr ) do i=1, max_asizev if (recvbuf(1+(i-1)*3) .ne. i ) then diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/typename3f.f b/teshsuite/smpi/mpich3-test/f77/datatype/typename3f.f index 17414d0e41..b67e6af2f6 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/typename3f.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/typename3f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C C (C) 2012 by Argonne National Laboratory. diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/typenamef.f b/teshsuite/smpi/mpich3-test/f77/datatype/typenamef.f index 611fbcfda1..82922a0f1c 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/typenamef.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/typenamef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C C (C) 2003 by Argonne National Laboratory. diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/typesnamef.f b/teshsuite/smpi/mpich3-test/f77/datatype/typesnamef.f index b958c4998e..48df213786 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/typesnamef.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/typesnamef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -11,7 +11,7 @@ C integer ntype1, ntype2, errs, ierr errs = 0 - + call MTest_Init( ierr ) call mpi_type_vector( 10, 1, 100, MPI_INTEGER, ntype1, ierr ) @@ -57,10 +57,10 @@ C now add a name, then dup errs = errs + 1 print *, ' (type2) Datatype name is not all blank' endif - + call mpi_type_free( ntype1, ierr ) call mpi_type_free( ntype2, ierr ) - + call MTest_Finalize( errs ) call MPI_Finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f77/datatype/typesubf.f b/teshsuite/smpi/mpich3-test/f77/datatype/typesubf.f index f175149231..2c87709097 100644 --- a/teshsuite/smpi/mpich3-test/f77/datatype/typesubf.f +++ b/teshsuite/smpi/mpich3-test/f77/datatype/typesubf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -32,7 +32,7 @@ C integer a(maxn,maxm) C and the subarray is C a(1+1:(maxn-3) +(1+1)-1,2+1:(maxm-4)+(2+1)-1) C i.e., a (start:(len + start - 1),...) - call mpi_type_create_subarray( 2, fullsizes, subsizes, starts, + call mpi_type_create_subarray( 2, fullsizes, subsizes, starts, & MPI_ORDER_FORTRAN, MPI_INTEGER, newtype, ierr ) call mpi_type_commit( newtype, ierr ) C @@ -48,8 +48,8 @@ C Prefill the array enddo enddo ssize = subsizes(1)*subsizes(2) - call mpi_sendrecv( fullarr, 1, newtype, rank, 0, - & subarr, ssize, MPI_INTEGER, rank, 0, + call mpi_sendrecv( fullarr, 1, newtype, rank, 0, + & subarr, ssize, MPI_INTEGER, rank, 0, & MPI_COMM_WORLD, MPI_STATUS_IGNORE, ierr ) C C Check the data diff --git a/teshsuite/smpi/mpich3-test/f77/ext/allocmemf.f b/teshsuite/smpi/mpich3-test/f77/ext/allocmemf.f index cc8792d672..cb4b0d65a2 100644 --- a/teshsuite/smpi/mpich3-test/f77/ext/allocmemf.f +++ b/teshsuite/smpi/mpich3-test/f77/ext/allocmemf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2004 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -7,7 +7,7 @@ C implicit none include 'mpif.h' C -C This program makes use of a common (but not universal; g77 doesn't +C This program makes use of a common (but not universal; g77 doesn't C have it) extension: the "Cray" pointer. This allows MPI_Alloc_mem C to allocate memory and return it to Fortran, where it can be used. C As this is not standard Fortran, this test is not run by default. diff --git a/teshsuite/smpi/mpich3-test/f77/ext/c2f2c.c b/teshsuite/smpi/mpich3-test/f77/ext/c2f2c.c index b704f72ad9..ee1f22148d 100644 --- a/teshsuite/smpi/mpich3-test/f77/ext/c2f2c.c +++ b/teshsuite/smpi/mpich3-test/f77/ext/c2f2c.c @@ -206,7 +206,7 @@ MPI_Fint c2ferrhandler_ ( MPI_Fint *errh ) fprintf( stderr, "Errhandler: did not get errors return\n" ); return 1; } - + return 0; } diff --git a/teshsuite/smpi/mpich3-test/f77/ext/c2f2cf.f b/teshsuite/smpi/mpich3-test/f77/ext/c2f2cf.f index 89850c1307..c2e0941977 100644 --- a/teshsuite/smpi/mpich3-test/f77/ext/c2f2cf.f +++ b/teshsuite/smpi/mpich3-test/f77/ext/c2f2cf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -57,7 +57,7 @@ C Test using a C routine to provide the Fortran handle errs = errs + 1 print *, "Comm(fortran) has wrong size or rank" endif - + call f2cgroup( group ) call mpi_group_size( group, fsize, ierr ) call mpi_group_rank( group, frank, ierr ) @@ -72,7 +72,7 @@ C Test using a C routine to provide the Fortran handle errs = errs + 1 print *, "Datatype(fortran) is not MPI_INT" endif - + call f2cinfo( info ) call mpi_info_get( info, "host", 100, value, flag, ierr ) if (.not. flag) then @@ -118,4 +118,4 @@ C call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f77/ext/ctypesinf.f b/teshsuite/smpi/mpich3-test/f77/ext/ctypesinf.f index 4693bc87c1..d1432bc9e3 100644 --- a/teshsuite/smpi/mpich3-test/f77/ext/ctypesinf.f +++ b/teshsuite/smpi/mpich3-test/f77/ext/ctypesinf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2010 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -46,4 +46,4 @@ C call mtest_finalize( errs ) call mpi_finalize( ierr ) - end + end diff --git a/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f b/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f index 204897c357..4b8e9dfa3e 100644 --- a/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f +++ b/teshsuite/smpi/mpich3-test/f77/info/infotest2f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -23,7 +23,7 @@ C errs = 0 call mtest_init( ierr ) - + C Note that the MPI standard requires that leading an trailing blanks C are stripped from keys and values (Section 4.10, The Info Object) C @@ -64,8 +64,8 @@ C keys are number from 0 to n-1, even in Fortran (Section 4.10) if (myvalue(ln:ln) .ne. ' ') then if (vlen .ne. ln) then errs = errs + 1 - print *, ' length is ', ln, - & ' but valuelen gave ', vlen, + print *, ' length is ', ln, + & ' but valuelen gave ', vlen, & ' for key ', mykey endif goto 100 @@ -102,30 +102,30 @@ C flag to false print *, ' Found unexpected key ', keys(i) endif myvalue = 'A test' - call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, + call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, & myvalue, flag, ierr ) if (flag) then errs = errs + 1 print *, ' Found unexpected key in MPI_Info_get ', keys(i) - else + else if (myvalue .ne. 'A test') then errs = errs + 1 print *, ' Returned value overwritten, is now ', myvalue endif endif - + enddo do i=3,6 myvalue = ' ' - call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, + call mpi_info_get( i2, keys(i), MPI_MAX_INFO_VAL, & myvalue, flag, ierr ) if (.not. flag) then errs = errs + 1 print *, ' Did not find key ', keys(i) - else + else if (myvalue .ne. values(i)) then errs = errs + 1 - print *, ' Found wrong value (', myvalue, ') for key ', + print *, ' Found wrong value (', myvalue, ') for key ', & keys(i) endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/info/infotestf.f b/teshsuite/smpi/mpich3-test/f77/info/infotestf.f index a2ec83bc2c..099a7431bb 100644 --- a/teshsuite/smpi/mpich3-test/f77/info/infotestf.f +++ b/teshsuite/smpi/mpich3-test/f77/info/infotestf.f @@ -1,9 +1,9 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. C -C Simple info test +C Simple info test program main implicit none include 'mpif.h' @@ -34,12 +34,12 @@ C if (.not. flag ) then print *, "Did not find key1 in info1" errs = errs + 1 - else + else if (value .ne. "value1") then print *, "Found wrong value (", value, "), expected value1" errs = errs + 1 else -C check for trailing blanks +C check for trailing blanks do i=7,valuelen if (value(i:i) .ne. " ") then print *, "Found non blank in info value" diff --git a/teshsuite/smpi/mpich3-test/f77/init/baseenvf.f b/teshsuite/smpi/mpich3-test/f77/init/baseenvf.f index b8b1f6ca0f..772d191f26 100644 --- a/teshsuite/smpi/mpich3-test/f77/init/baseenvf.f +++ b/teshsuite/smpi/mpich3-test/f77/init/baseenvf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -27,7 +27,7 @@ C provided = -1 call mpi_init_thread( MPI_THREAD_MULTIPLE, provided, ierr ) - if (provided .ne. MPI_THREAD_MULTIPLE .and. + if (provided .ne. MPI_THREAD_MULTIPLE .and. & provided .ne. MPI_THREAD_SERIALIZED .and. & provided .ne. MPI_THREAD_FUNNELED .and. & provided .ne. MPI_THREAD_SINGLE) then @@ -41,7 +41,7 @@ C if (iv .ne. MPI_VERSION .or. isubv .ne. MPI_SUBVERSION) then errs = errs + 1 print *, 'Version in mpif.h and get_version do not agree' - print *, 'Version in mpif.h is ', MPI_VERSION, '.', + print *, 'Version in mpif.h is ', MPI_VERSION, '.', & MPI_SUBVERSION print *, 'Version in get_version is ', iv, '.', isubv endif @@ -63,7 +63,7 @@ C errs = errs + 1 print *, 'is_thread_main returned false for main thread' endif - + call mpi_query_thread( qprovided, ierr ) if (qprovided .ne. provided) then errs = errs + 1 @@ -80,7 +80,7 @@ C endif if (rank .eq. 0) then - if (errs .eq. 0) then + if (errs .eq. 0) then print *, ' No Errors' else print *, ' Found ', errs, ' errors' diff --git a/teshsuite/smpi/mpich3-test/f77/pt2pt/allpairf.f b/teshsuite/smpi/mpich3-test/f77/pt2pt/allpairf.f index 49b047f156..ccaf5a5556 100644 --- a/teshsuite/smpi/mpich3-test/f77/pt2pt/allpairf.f +++ b/teshsuite/smpi/mpich3-test/f77/pt2pt/allpairf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2012 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -14,7 +14,7 @@ C fsset@corelli.lerc.nasa.gov (Scott Townsend) logical mtestGetIntraComm logical verbose common /flags/ verbose - + errs = 0 verbose = .false. C verbose = .true. @@ -34,7 +34,7 @@ C verbose = .true. call test_pair_sendrecvrepl( comm, errs ) call mtestFreeComm( comm ) enddo -C +C call MTest_Finalize( errs ) call MPI_Finalize(ierr) C @@ -74,7 +74,7 @@ C call init_test_data(send_buf,TEST_SIZE) C call MPI_Send(send_buf, count, MPI_REAL, next, tag, - . comm, ierr) + . comm, ierr) C call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr) @@ -88,7 +88,7 @@ C call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, . 'send and recv', errs ) C - call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr) + call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr) end if C end @@ -124,16 +124,16 @@ C call clear_test_data(recv_buf,TEST_SIZE) C if (rank .eq. 0) then -C +C call init_test_data(send_buf,TEST_SIZE) C - call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, + call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, . comm, status, ierr ) C call MPI_Rsend(send_buf, count, MPI_REAL, next, tag, - . comm, ierr) + . comm, ierr) C - call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr) + call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr) C if (status(MPI_SOURCE) .ne. next) then print *, 'Rsend: Incorrect source, expected', next, @@ -156,7 +156,7 @@ C end if C call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, - . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, + . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, . status, ierr) C call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, @@ -167,14 +167,14 @@ C call MPI_Irecv(recv_buf, TEST_SIZE, MPI_REAL, . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, . requests(1), ierr) - call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag, + call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag, . comm, ierr ) call MPI_Wait( requests(1), status, ierr ) call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, . 'rsend and recv', errs ) C call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, - . comm, ierr) + . comm, ierr) end if C end @@ -215,23 +215,23 @@ C call init_test_data(send_buf,TEST_SIZE) C call MPI_Iprobe(MPI_ANY_SOURCE, tag, - . comm, flag, status, ierr) + . comm, flag, status, ierr) C if (flag) then - print *, 'Ssend: Iprobe succeeded! source', + print *, 'Ssend: Iprobe succeeded! source', . status(MPI_SOURCE), . ', tag', status(MPI_TAG) errs = errs + 1 end if C call MPI_Ssend(send_buf, count, MPI_REAL, next, tag, - . comm, ierr) + . comm, ierr) C do while (.not. flag) call MPI_Iprobe(MPI_ANY_SOURCE, tag, - . comm, flag, status, ierr) + . comm, flag, status, ierr) end do -C +C if (status(MPI_SOURCE) .ne. next) then print *, 'Ssend: Incorrect source, expected', next, . ', got', status(MPI_SOURCE) @@ -257,7 +257,7 @@ C . status, ierr) C call msg_check( recv_buf, next, tag, count, status, - . TEST_SIZE, 'ssend and recv', errs ) + . TEST_SIZE, 'ssend and recv', errs ) C else if (prev .eq. 0) then C @@ -269,7 +269,7 @@ C . 'ssend and recv', errs ) C call MPI_Ssend(recv_buf, count, MPI_REAL, prev, tag, - . comm, ierr) + . comm, ierr) end if C end @@ -314,7 +314,7 @@ C call init_test_data(send_buf,TEST_SIZE) C call MPI_Isend(send_buf, count, MPI_REAL, next, tag, - . comm, requests(2), ierr) + . comm, requests(2), ierr) C call MPI_Waitall(2, requests, statuses, ierr) C @@ -333,7 +333,7 @@ C . 'isend and irecv', errs ) C call MPI_Isend(recv_buf, count, MPI_REAL, prev, tag, - . comm, requests(1), ierr) + . comm, requests(1), ierr) C call MPI_Wait(requests(1), status, ierr) C @@ -385,12 +385,12 @@ C C call init_test_data(send_buf,TEST_SIZE) C - call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, next, 0, - . MPI_BOTTOM, 0, MPI_INTEGER, next, 0, + call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, next, 0, + . MPI_BOTTOM, 0, MPI_INTEGER, next, 0, . dupcom, status, ierr ) C call MPI_Irsend(send_buf, count, MPI_REAL, next, tag, - . comm, requests(2), ierr) + . comm, requests(2), ierr) C index = -1 do while (index .ne. 1) @@ -408,8 +408,8 @@ C . MPI_ANY_SOURCE, MPI_ANY_TAG, comm, . requests(1), ierr) C - call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, prev, 0, - . MPI_BOTTOM, 0, MPI_INTEGER, prev, 0, + call MPI_Sendrecv( MPI_BOTTOM, 0, MPI_INTEGER, prev, 0, + . MPI_BOTTOM, 0, MPI_INTEGER, prev, 0, . dupcom, status, ierr ) C flag = .FALSE. @@ -423,7 +423,7 @@ C . 'irsend and irecv', errs ) C call MPI_Irsend(recv_buf, count, MPI_REAL, prev, tag, - . comm, requests(1), ierr) + . comm, requests(1), ierr) C call MPI_Waitall(1, requests, statuses, ierr) C @@ -476,7 +476,7 @@ C call init_test_data(send_buf,TEST_SIZE) C call MPI_Issend(send_buf, count, MPI_REAL, next, tag, - . comm, requests(2), ierr) + . comm, requests(2), ierr) C flag = .FALSE. do while (.not. flag) @@ -498,7 +498,7 @@ C . 'issend and recv', errs ) call MPI_Issend(recv_buf, count, MPI_REAL, prev, tag, - . comm, requests(1), ierr) + . comm, requests(1), ierr) C flag = .FALSE. do while (.not. flag) @@ -550,9 +550,9 @@ C call init_test_data(send_buf,TEST_SIZE) C call MPI_Send_init(send_buf, count, MPI_REAL, next, tag, - . comm, requests(1), ierr) + . comm, requests(1), ierr) C - call MPI_Startall(2, requests, ierr) + call MPI_Startall(2, requests, ierr) call MPI_Waitall(2, requests, statuses, ierr) C call msg_check( recv_buf, next, tag, count, statuses(1,2), @@ -563,8 +563,8 @@ C else if (prev .eq. 0) then C call MPI_Send_init(send_buf, count, MPI_REAL, prev, tag, - . comm, requests(1), ierr) - call MPI_Start(requests(2), ierr) + . comm, requests(1), ierr) + call MPI_Start(requests(2), ierr) call MPI_Wait(requests(2), status, ierr) C call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, @@ -574,7 +574,7 @@ C send_buf(i) = recv_buf(i) end do C - call MPI_Start(requests(1), ierr) + call MPI_Start(requests(1), ierr) call MPI_Wait(requests(1), status, ierr) C call MPI_Request_free(requests(1), ierr) @@ -624,11 +624,11 @@ C if (rank .eq. 0) then C call MPI_Rsend_init(send_buf, count, MPI_REAL, next, tag, - . comm, requests(1), ierr) + . comm, requests(1), ierr) C call init_test_data(send_buf,TEST_SIZE) C - call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, + call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, . comm, status, ierr ) C call MPI_Startall(2, requests, ierr) @@ -651,11 +651,11 @@ C else if (prev .eq. 0) then C call MPI_Rsend_init(send_buf, count, MPI_REAL, prev, tag, - . comm, requests(1), ierr) + . comm, requests(1), ierr) C call MPI_Start(requests(2), ierr) C - call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag, + call MPI_Send( MPI_BOTTOM, 0, MPI_INTEGER, prev, tag, . comm, ierr ) C flag = .FALSE. @@ -719,7 +719,7 @@ C if (rank .eq. 0) then C call MPI_Ssend_init(send_buf, count, MPI_REAL, next, tag, - . comm, requests(2), ierr) + . comm, requests(2), ierr) C call init_test_data(send_buf,TEST_SIZE) C @@ -743,7 +743,7 @@ C else if (prev .eq. 0) then C call MPI_Ssend_init(send_buf, count, MPI_REAL, prev, tag, - . comm, requests(2), ierr) + . comm, requests(2), ierr) C call MPI_Start(requests(1), ierr) C @@ -807,7 +807,7 @@ C call MPI_Sendrecv(send_buf, count, MPI_REAL, next, tag, . recv_buf, count, MPI_REAL, next, tag, - . comm, status, ierr) + . comm, status, ierr) call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, . 'sendrecv', errs ) @@ -822,7 +822,7 @@ C . 'recv/send', errs ) call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, - . comm, ierr) + . comm, ierr) end if C end @@ -864,7 +864,7 @@ C C call MPI_Sendrecv_replace(recv_buf, count, MPI_REAL, . next, tag, next, tag, - . comm, status, ierr) + . comm, status, ierr) call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, . 'sendrecvreplace', errs ) @@ -881,7 +881,7 @@ C . 'recv/send for replace', errs ) call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, - . comm, ierr) + . comm, ierr) end if C end @@ -891,7 +891,7 @@ c c Check for correct source, tag, count, and data in test message. c c------------------------------------------------------------------------------ - subroutine msg_check( recv_buf, source, tag, count, status, n, + subroutine msg_check( recv_buf, source, tag, count, status, n, * name, errs ) implicit none include 'mpif.h' @@ -908,7 +908,7 @@ c------------------------------------------------------------------------------ call MPI_Get_count(status, MPI_REAL, recv_count, ierr) if (recv_src .ne. source) then - print *, '[', rank, '] Unexpected source:', recv_src, + print *, '[', rank, '] Unexpected source:', recv_src, * ' in ', name errs = errs + 1 end if @@ -923,7 +923,7 @@ c------------------------------------------------------------------------------ * ' in ', name errs = errs + 1 end if - + call verify_test_data(recv_buf, count, n, name, errs ) end @@ -943,7 +943,7 @@ c print *, 'Nonnull request in ', msg endif 10 continue -c +c end c------------------------------------------------------------------------------ c @@ -1002,14 +1002,14 @@ C errs = errs + 1 endif 20 continue -C +C 100 format('Invalid data', f6.1, ' at ', i4, ' of ', i4, ' in ', a) C end C -C This routine is used to prevent the compiler from deallocating the -C array "a", which may happen in some of the tests (see the text in -C the MPI standard about why this may be a problem in valid Fortran +C This routine is used to prevent the compiler from deallocating the +C array "a", which may happen in some of the tests (see the text in +C the MPI standard about why this may be a problem in valid Fortran C codes). Without this, for example, tests fail with the Cray ftn C compiler. C diff --git a/teshsuite/smpi/mpich3-test/f77/pt2pt/dummyf.f b/teshsuite/smpi/mpich3-test/f77/pt2pt/dummyf.f index 7524a194e0..7cac7ba65a 100644 --- a/teshsuite/smpi/mpich3-test/f77/pt2pt/dummyf.f +++ b/teshsuite/smpi/mpich3-test/f77/pt2pt/dummyf.f @@ -1,14 +1,14 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2010 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. C C C This file is used to disable certain compiler optimizations that -C can cause incorrect results with the test in greqf.f. It provides a +C can cause incorrect results with the test in greqf.f. It provides a C point where extrastate may be modified, limiting the compilers ability C to move code around. -C The include of mpif.h is not needed in the F77 case but in the +C The include of mpif.h is not needed in the F77 case but in the C F90 case it is, because in that case, extrastate is defined as an C integer (kind=MPI_ADDRESS_KIND), and the script that creates the C F90 tests from the F77 tests looks for mpif.h diff --git a/teshsuite/smpi/mpich3-test/f77/pt2pt/greqf.f b/teshsuite/smpi/mpich3-test/f77/pt2pt/greqf.f index 163f0794b0..5c467b1526 100644 --- a/teshsuite/smpi/mpich3-test/f77/pt2pt/greqf.f +++ b/teshsuite/smpi/mpich3-test/f77/pt2pt/greqf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -31,7 +31,7 @@ C print *, 'Free_fn called' C extrastate = extrastate - 1 C The value returned by the free function is the error code -C returned by the wait/test function +C returned by the wait/test function ierr = MPI_SUCCESS end C @@ -50,10 +50,10 @@ C This is a very simple test of generalized requests. Normally, the C MPI_Grequest_complete function would be called from another routine, C often running in a separate thread. This simple code allows us to C check that requests can be created, tested, and waited on in the -C case where the request is complete before the wait is called. +C case where the request is complete before the wait is called. C C Note that MPI did *not* define a routine that can be called within -C test or wait to advance the state of a generalized request. +C test or wait to advance the state of a generalized request. C Most uses of generalized requests will need to use a separate thread. C program main @@ -70,36 +70,36 @@ C errs = 0 freefncall = 0 - + call MTest_Init( ierr ) extrastate = 0 - call mpi_grequest_start( query_fn, free_fn, cancel_fn, + call mpi_grequest_start( query_fn, free_fn, cancel_fn, & extrastate, request, ierr ) call mpi_test( request, flag, status, ierr ) if (flag) then errs = errs + 1 print *, 'Generalized request marked as complete' endif - + call mpi_grequest_complete( request, ierr ) call MPI_Wait( request, status, ierr ) extrastate = 1 - call mpi_grequest_start( query_fn, free_fn, cancel_fn, + call mpi_grequest_start( query_fn, free_fn, cancel_fn, & extrastate, request, ierr ) call mpi_grequest_complete( request, ierr ) call mpi_wait( request, MPI_STATUS_IGNORE, ierr ) -C -C The following routine may prevent an optimizing compiler from +C +C The following routine may prevent an optimizing compiler from C just remembering that extrastate was set in grequest_start call dummyupdate(extrastate) if (extrastate .ne. 0) then errs = errs + 1 if (freefncall .eq. 0) then print *, 'Free routine not called' - else + else print *, 'Free routine did not update extra_data' print *, 'extrastate = ', extrastate endif diff --git a/teshsuite/smpi/mpich3-test/f77/pt2pt/mprobef.f b/teshsuite/smpi/mpich3-test/f77/pt2pt/mprobef.f index e1e554f836..428b71d5c5 100644 --- a/teshsuite/smpi/mpich3-test/f77/pt2pt/mprobef.f +++ b/teshsuite/smpi/mpich3-test/f77/pt2pt/mprobef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2012 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -18,20 +18,20 @@ C call mpi_init( ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, ' Unexpected return from MPI_INIT', ierr + print *, ' Unexpected return from MPI_INIT', ierr endif call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr ) call mpi_comm_size( MPI_COMM_WORLD, size, ierr ) if (size .lt. 2) then errs = errs + 1 - print *, ' This test requires at least 2 processes' -C Abort now - do not continue in this case. + print *, ' This test requires at least 2 processes' +C Abort now - do not continue in this case. call mpi_abort( MPI_COMM_WORLD, 1, ierr ) endif if (size .gt. 2) then print *, ' This test is running with ', size, ' processes,' - print *, ' only 2 processes are used.' + print *, ' only 2 processes are used.' endif C Test 0: simple Send and Mprobe+Mrecv. @@ -152,7 +152,7 @@ C the error fields are initialized for modification check. if (rreq .eq. MPI_REQUEST_NULL) then errs = errs + 1 print *, 'rreq is unmodified at T1 Imrecv().' - endif + endif call MPI_Wait(rreq, s2, ierr) if (recvbuf(1) .ne. 1735928559) then errs = errs + 1 @@ -306,7 +306,7 @@ C the error fields are initialized for modification check. if (rreq .eq. MPI_REQUEST_NULL) then errs = errs + 1 print *, 'rreq is unmodified at T3 Imrecv().' - endif + endif call MPI_Wait(rreq, s2, ierr) if (recvbuf(1) .ne. 1735928559) then errs = errs + 1 diff --git a/teshsuite/smpi/mpich3-test/f77/pt2pt/statusesf.f b/teshsuite/smpi/mpich3-test/f77/pt2pt/statusesf.f index b01d26bc6a..96c9c2edf5 100644 --- a/teshsuite/smpi/mpich3-test/f77/pt2pt/statusesf.f +++ b/teshsuite/smpi/mpich3-test/f77/pt2pt/statusesf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -18,14 +18,14 @@ C Test support for MPI_STATUS_IGNORE and MPI_STATUSES_IGNORE call mpi_init( ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_INIT', ierr + print *, 'Unexpected return from MPI_INIT', ierr endif ierr = -1 call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_COMM_WORLD', ierr + print *, 'Unexpected return from MPI_COMM_WORLD', ierr endif do i=1, nreqs, 2 ierr = -1 @@ -33,14 +33,14 @@ C Test support for MPI_STATUS_IGNORE and MPI_STATUSES_IGNORE $ MPI_COMM_WORLD, reqs(i), ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_ISEND', ierr + print *, 'Unexpected return from MPI_ISEND', ierr endif ierr = -1 call mpi_irecv( MPI_BOTTOM, 0, MPI_BYTE, rank, i, $ MPI_COMM_WORLD, reqs(i+1), ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_IRECV', ierr + print *, 'Unexpected return from MPI_IRECV', ierr endif enddo @@ -48,7 +48,7 @@ C Test support for MPI_STATUS_IGNORE and MPI_STATUSES_IGNORE call mpi_waitall( nreqs, reqs, MPI_STATUSES_IGNORE, ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_WAITALL', ierr + print *, 'Unexpected return from MPI_WAITALL', ierr endif call mtest_finalize( errs ) diff --git a/teshsuite/smpi/mpich3-test/f77/rma/baseattrwinf.f b/teshsuite/smpi/mpich3-test/f77/rma/baseattrwinf.f index 58b86f6c58..91d28dc039 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/baseattrwinf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/baseattrwinf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,14 +17,14 @@ C Include addsize defines asize as an address-sized integer include 'addsize.h' errs = 0 - + call mtest_init( ierr ) call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr ) -C Create a window; then extract the values +C Create a window; then extract the values asize = 1024 disp = 4 - call MPI_Win_create( base, asize, disp, MPI_INFO_NULL, + call MPI_Win_create( base, asize, disp, MPI_INFO_NULL, & MPI_COMM_WORLD, win, ierr ) C C In order to check the base, we need an address-of function. @@ -34,8 +34,8 @@ C We use MPI_Get_address, even though that isn't strictly correct errs = errs + 1 print *, "Could not get WIN_BASE" C -C There is no easy way to get the actual value of base to compare -C against. MPI_Address gives a value relative to MPI_BOTTOM, which +C There is no easy way to get the actual value of base to compare +C against. MPI_Address gives a value relative to MPI_BOTTOM, which C is different from 0 in Fortran (unless you can define MPI_BOTTOM C as something like %pointer(0)). C else @@ -44,7 +44,7 @@ CC For this Fortran 77 version, we use the older MPI_Address function C call MPI_Address( base, baseadd, ierr ) C if (valout .ne. baseadd) then C errs = errs + 1 -C print *, "Got incorrect value for WIN_BASE (", valout, +C print *, "Got incorrect value for WIN_BASE (", valout, C & ", should be ", baseadd, ")" C endif endif @@ -56,7 +56,7 @@ C endif else if (valout .ne. asize) then errs = errs + 1 - print *, "Got incorrect value for WIN_SIZE (", valout, + print *, "Got incorrect value for WIN_SIZE (", valout, & ", should be ", asize, ")" endif endif @@ -68,7 +68,7 @@ C endif else if (valout .ne. disp) then errs = errs + 1 - print *, "Got wrong value for WIN_DISP_UNIT (", valout, + print *, "Got wrong value for WIN_DISP_UNIT (", valout, & ", should be ", disp, ")" endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/rma/c2f2cwinf.f b/teshsuite/smpi/mpich3-test/f77/rma/c2f2cwinf.f index c757f1e38f..7dafbf6d69 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/c2f2cwinf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/c2f2cwinf.f @@ -1,8 +1,8 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. -C +C C Test just MPI-RMA C program main @@ -23,7 +23,7 @@ C C Test passing a Fortran MPI object to C call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr ) asize = 0 - call mpi_win_create( 0, asize, 1, MPI_INFO_NULL, + call mpi_win_create( 0, asize, 1, MPI_INFO_NULL, $ MPI_COMM_WORLD, win, ierr ) errs = errs + c2fwin( win ) call mpi_win_free( win, ierr ) @@ -34,7 +34,7 @@ C Test using a C routine to provide the Fortran handle C no info, in comm world, created with no memory (base address 0, C displacement unit 1 call mpi_win_free( win, ierr ) - + C C Summarize the errors C @@ -50,4 +50,4 @@ C call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winaccf.f b/teshsuite/smpi/mpich3-test/f77/rma/winaccf.f index 24eaf9dacf..fb185d6b83 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winaccf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winaccf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,16 +17,16 @@ C logical mtestGetIntraComm C Include addsize defines asize as an address-sized integer include 'addsize.h' - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize - call mpi_win_create( buf, asize, intsize * nrows, + call mpi_win_create( buf, asize, intsize * nrows, & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) left = rank - 1 @@ -38,7 +38,7 @@ C Include addsize defines asize as an address-sized integer right = MPI_PROC_NULL endif C -C Initialize the buffer +C Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -49,16 +49,16 @@ C Initialize the buffer enddo enddo call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr ) -C +C asize = ncols + 1 - call mpi_accumulate( buf(1,1), nrows, MPI_INTEGER, - & left, asize, + call mpi_accumulate( buf(1,1), nrows, MPI_INTEGER, + & left, asize, & nrows, MPI_INTEGER, MPI_SUM, win, ierr ) asize = 0 call mpi_accumulate( buf(1,ncols), nrows, MPI_INTEGER, right, & asize, nrows, MPI_INTEGER, MPI_SUM, win, ierr ) -C - call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + +C + call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + & MPI_MODE_NOSUCCEED, win, ierr ) C C Check the results @@ -79,7 +79,7 @@ C Check the results if (buf(i,ncols+1) .ne. ans) then errs = errs + 1 if (errs .le. 10) then - print *, ' buf(',i,',',ncols+1,') = ', + print *, ' buf(',i,',',ncols+1,') = ', & buf(i,ncols+1) endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winattr2f.f b/teshsuite/smpi/mpich3-test/f77/rma/winattr2f.f index 1bae8363c3..c07cea6dbd 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winattr2f.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winattr2f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,7 +17,7 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 call mtest_init( ierr ) @@ -26,10 +26,10 @@ C Create a new window; use val for an address-sized int val = 10 call mpi_win_create( buf, val, 1, & MPI_INFO_NULL, comm, win, ierr ) -C +C extrastate = 1001 - call mpi_win_create_keyval( MPI_WIN_DUP_FN, - & MPI_WIN_NULL_DELETE_FN, keyval, + call mpi_win_create_keyval( MPI_WIN_DUP_FN, + & MPI_WIN_NULL_DELETE_FN, keyval, & extrastate, ierr ) flag = .true. call mpi_win_get_attr( win, keyval, valout, flag, ierr ) @@ -45,10 +45,10 @@ C call mpi_win_get_attr( win, keyval, valout, flag, ierr ) if (valout .ne. 2003) then errs = errs + 1 - print *, 'Unexpected value (should be 2003)', valout, + print *, 'Unexpected value (should be 2003)', valout, & ' from attr' endif - + valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) flag = .false. @@ -56,7 +56,7 @@ C call mpi_win_get_attr( win, keyval, valout, flag, ierr ) if (valout .ne. 2001) then errs = errs + 1 - print *, 'Unexpected value (should be 2001)', valout, + print *, 'Unexpected value (should be 2001)', valout, & ' from attr' endif C @@ -68,7 +68,7 @@ C Test the attr delete function errs = errs + 1 print *, ' Delete_attr did not delete attribute' endif - + C Test the delete function on window free valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winattrf.f b/teshsuite/smpi/mpich3-test/f77/rma/winattrf.f index 7b1336265b..0b0501823f 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winattrf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winattrf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -18,7 +18,7 @@ C C The only difference between the MPI-2 and MPI-1 attribute caching C routines in Fortran is that the take an address-sized integer C instead of a simple integer. These still are not pointers, -C so the values are still just integers. +C so the values are still just integers. C errs = 0 callcount = 0 @@ -29,9 +29,9 @@ C Create a new window; use val for an address-sized int val = 10 call mpi_win_create( buf, val, 1, & MPI_INFO_NULL, comm, win, ierr ) -C +C extrastate = 1001 - call mpi_win_create_keyval( mycopyfn, mydelfn, keyval, + call mpi_win_create_keyval( mycopyfn, mydelfn, keyval, & extrastate, ierr ) flag = .true. call mpi_win_get_attr( win, keyval, valout, flag, ierr ) @@ -47,10 +47,10 @@ C call mpi_win_get_attr( win, keyval, valout, flag, ierr ) if (valout .ne. 2003) then errs = errs + 1 - print *, 'Unexpected value (should be 2003)', valout, + print *, 'Unexpected value (should be 2003)', valout, & ' from attr' endif - + valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) flag = .false. @@ -58,7 +58,7 @@ C call mpi_win_get_attr( win, keyval, valout, flag, ierr ) if (valout .ne. 2001) then errs = errs + 1 - print *, 'Unexpected value (should be 2001)', valout, + print *, 'Unexpected value (should be 2001)', valout, & ' from attr' endif C @@ -75,7 +75,7 @@ C Test the attr delete function errs = errs + 1 print *, ' Delete_attr did not delete attribute' endif - + C Test the delete function on window free valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) @@ -83,7 +83,7 @@ C Test the delete function on window free call mpi_win_free( win, ierr ) if (delcount .ne. curcount + 1) then errs = errs + 1 - print *, ' did not get expected value of delcount ', + print *, ' did not get expected value of delcount ', & delcount, curcount + 1 endif @@ -104,14 +104,14 @@ C as defined. To test them, we simply call them here valout = -1 ierr = -1 call MPI_WIN_DUP_FN( win, keyval, extrastate, valin, valout, - $ flag, ierr ) + $ flag, ierr ) if (.not. flag) then errs = errs + 1 print *, " Flag was false after MPI_WIN_DUP_FN" else if (valout .ne. 7001) then errs = errs + 1 if (valout .eq. -1 ) then - print *, " output attr value was not copied in MPI_WIN_DUP_FN" + print *, " output attr value was not copied in MPI_WIN_DUP_FN" endif print *, " value was ", valout, " but expected 7001" else if (ierr .ne. MPI_SUCCESS) then @@ -124,14 +124,14 @@ C as defined. To test them, we simply call them here valout = -1 ierr = -1 call MPI_WIN_NULL_COPY_FN( win, keyval, extrastate, valin, valout - $ ,flag, ierr ) + $ ,flag, ierr ) if (flag) then errs = errs + 1 print *, " Flag was true after MPI_WIN_NULL_COPY_FN" else if (valout .ne. -1) then errs = errs + 1 print *, - $ " output attr value was copied in MPI_WIN_NULL_COPY_FN" + $ " output attr value was copied in MPI_WIN_NULL_COPY_FN" else if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 print *, " MPI_WIN_NULL_COPY_FN did not return MPI_SUCCESS" diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winerrf.f b/teshsuite/smpi/mpich3-test/f77/rma/winerrf.f index 6d3d4f8cc1..ac690ce50a 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winerrf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winerrf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -12,7 +12,7 @@ C integer buf(10) integer win external myerrhanfunc -CF90 INTERFACE +CF90 INTERFACE CF90 SUBROUTINE myerrhanfunc(vv0,vv1) CF90 INTEGER vv0,vv1 CF90 END SUBROUTINE @@ -60,25 +60,25 @@ C We can free our error handler now call mpi_win_call_errhandler( win, newerrclass, ierr ) call mpi_win_call_errhandler( win, code(1), ierr ) call mpi_win_call_errhandler( win, code(2), ierr ) - + if (callcount .ne. 3) then errs = errs + 1 - print *, ' Expected 3 calls to error handler, found ', + print *, ' Expected 3 calls to error handler, found ', & callcount else if (codesSeen(1) .ne. newerrclass) then errs = errs + 1 - print *, 'Expected class ', newerrclass, ' got ', + print *, 'Expected class ', newerrclass, ' got ', & codesSeen(1) endif if (codesSeen(2) .ne. code(1)) then errs = errs + 1 - print *, 'Expected code ', code(1), ' got ', + print *, 'Expected code ', code(1), ' got ', & codesSeen(2) endif if (codesSeen(3) .ne. code(2)) then errs = errs + 1 - print *, 'Expected code ', code(2), ' got ', + print *, 'Expected code ', code(2), ' got ', & codesSeen(3) endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winfencef.f b/teshsuite/smpi/mpich3-test/f77/rma/winfencef.f index 565cc5bddf..6ac2731543 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winfencef.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winfencef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,16 +17,16 @@ C logical mtestGetIntraComm C Include addsize defines asize as an address-sized integer include 'addsize.h' - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize - call mpi_win_create( buf, asize, intsize * nrows, + call mpi_win_create( buf, asize, intsize * nrows, & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) left = rank - 1 @@ -38,7 +38,7 @@ C Include addsize defines asize as an address-sized integer right = MPI_PROC_NULL endif C -C Initialize the buffer +C Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -49,15 +49,15 @@ C Initialize the buffer enddo enddo call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr ) -C +C asize = ncols+1 - call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, + call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, & nrows, MPI_INTEGER, win, ierr ) asize = 0 - call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, + call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, & nrows, MPI_INTEGER, win, ierr ) -C - call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + +C + call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + & MPI_MODE_NOSUCCEED, win, ierr ) C C Check the results @@ -79,7 +79,7 @@ C Check the results if (buf(i,ncols+1) .ne. ans) then errs = errs + 1 if (errs .le. 10) then - print *, rank, ' buf(',i,',',ncols+1,') = ', + print *, rank, ' buf(',i,',',ncols+1,') = ', & buf(i,ncols+1), ' expected ', ans endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/rma/wingetf.f b/teshsuite/smpi/mpich3-test/f77/rma/wingetf.f index 3d5115881a..cf180a6a4a 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/wingetf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/wingetf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,16 +17,16 @@ C logical mtestGetIntraComm C Include addsize defines asize as an address-sized integer include 'addsize.h' - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize - call mpi_win_create( buf, asize, intsize * nrows, + call mpi_win_create( buf, asize, intsize * nrows, & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) left = rank - 1 @@ -38,7 +38,7 @@ C Include addsize defines asize as an address-sized integer right = MPI_PROC_NULL endif C -C Initialize the buffer +C Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -49,15 +49,15 @@ C Initialize the buffer enddo enddo call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr ) -C +C asize = 1 call mpi_get( buf(1,ncols+1), nrows, MPI_INTEGER, right, & asize, nrows, MPI_INTEGER, win, ierr ) asize = ncols - call mpi_get( buf(1,0), nrows, MPI_INTEGER, left, + call mpi_get( buf(1,0), nrows, MPI_INTEGER, left, & asize, nrows, MPI_INTEGER, win, ierr ) -C - call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + +C + call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + & MPI_MODE_NOSUCCEED, win, ierr ) C C Check the results @@ -79,7 +79,7 @@ C Check the results if (buf(i,ncols+1) .ne. ans) then errs = errs + 1 if (errs .le. 10) then - print *, rank, ' buf(',i,',',ncols+1,') = ', + print *, rank, ' buf(',i,',',ncols+1,') = ', & buf(i,ncols+1), ' expected ', ans endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/rma/wingroupf.f b/teshsuite/smpi/mpich3-test/f77/rma/wingroupf.f index 8c0cb760a6..76514ea3df 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/wingroupf.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/wingroupf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -16,11 +16,11 @@ C call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = 10 - call mpi_win_create( buf, asize, intsize, + call mpi_win_create( buf, asize, intsize, & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_group( comm, group1, ierr ) call mpi_win_get_group( win, group2, ierr ) call mpi_group_compare( group1, group2, result, ierr ) diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winnamef.f b/teshsuite/smpi/mpich3-test/f77/rma/winnamef.f index 5f59d6e3b1..0e5ca299ce 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winnamef.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winnamef.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -19,10 +19,10 @@ C call mtest_init( ierr ) C C Create a window and get, set the names on it -C +C call mpi_type_size( MPI_INTEGER, intsize, ierr ) asize = 10 - call mpi_win_create( buf, asize, intsize, + call mpi_win_create( buf, asize, intsize, & MPI_INFO_NULL, MPI_COMM_WORLD, win, ierr ) C C Check that there is no name yet @@ -71,7 +71,7 @@ C Now, set a name and check it print *, ' window name is not blank padded' endif endif -C +C call mpi_win_free( win, ierr ) call mtest_finalize( errs ) call mpi_finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winscale1f.f b/teshsuite/smpi/mpich3-test/f77/rma/winscale1f.f index 9a978f6658..5ef4c75d2a 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winscale1f.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winscale1f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -17,16 +17,16 @@ C logical mtestGetIntraComm C Include addsize defines asize as an address-sized integer include 'addsize.h' - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize - call mpi_win_create( buf, asize, intsize * nrows, + call mpi_win_create( buf, asize, intsize * nrows, & MPI_INFO_NULL, comm, win, ierr ) - + C Create the group for the neighbors call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) @@ -49,7 +49,7 @@ C Create the group for the neighbors call mpi_group_incl( group, nneighbors, nbrs, group2, ierr ) call mpi_group_free( group, ierr ) C -C Initialize the buffer +C Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -61,14 +61,14 @@ C Initialize the buffer enddo call mpi_win_post( group2, 0, win, ierr ) call mpi_win_start( group2, 0, win, ierr ) -C +C asize = ncols+1 - call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, + call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, & nrows, MPI_INTEGER, win, ierr ) asize = 0 - call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, + call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, & nrows, MPI_INTEGER, win, ierr ) -C +C call mpi_win_complete( win, ierr ) call mpi_win_wait( win, ierr ) C diff --git a/teshsuite/smpi/mpich3-test/f77/rma/winscale2f.f b/teshsuite/smpi/mpich3-test/f77/rma/winscale2f.f index 8b1108c3de..9177884a1c 100644 --- a/teshsuite/smpi/mpich3-test/f77/rma/winscale2f.f +++ b/teshsuite/smpi/mpich3-test/f77/rma/winscale2f.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -18,16 +18,16 @@ C logical flag C Include addsize defines asize as an address-sized integer include 'addsize.h' - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize - call mpi_win_create( buf, asize, intsize * nrows, + call mpi_win_create( buf, asize, intsize * nrows, & MPI_INFO_NULL, comm, win, ierr ) - + C Create the group for the neighbors call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) @@ -50,7 +50,7 @@ C Create the group for the neighbors call mpi_group_incl( group, nneighbors, nbrs, group2, ierr ) call mpi_group_free( group, ierr ) C -C Initialize the buffer +C Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -62,14 +62,14 @@ C Initialize the buffer enddo call mpi_win_post( group2, 0, win, ierr ) call mpi_win_start( group2, 0, win, ierr ) -C +C asize = ncols+1 call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, & nrows, MPI_INTEGER, win, ierr ) asize = 0 - call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, + call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, & nrows, MPI_INTEGER, win, ierr ) -C +C call mpi_win_complete( win, ierr ) flag = .false. do while (.not. flag) @@ -83,7 +83,7 @@ C Check the results if (buf(i,0) .ne. ans) then errs = errs + 1 if (errs .le. 10) then - print *, ' buf(',i,',0) = ', buf(i,0), + print *, ' buf(',i,',0) = ', buf(i,0), & 'expected ', ans endif endif @@ -95,7 +95,7 @@ C Check the results if (buf(i,ncols+1) .ne. ans) then errs = errs + 1 if (errs .le. 10) then - print *, ' buf(',i,',',ncols+1,') = ', + print *, ' buf(',i,',',ncols+1,') = ', & buf(i,ncols+1), ' expected ', ans endif endif diff --git a/teshsuite/smpi/mpich3-test/f77/topo/cartcrf.f b/teshsuite/smpi/mpich3-test/f77/topo/cartcrf.f index e6d046b53c..9657504413 100644 --- a/teshsuite/smpi/mpich3-test/f77/topo/cartcrf.f +++ b/teshsuite/smpi/mpich3-test/f77/topo/cartcrf.f @@ -1,9 +1,9 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2004 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. C -C Test various combinations of periodic and non-periodic Cartesian +C Test various combinations of periodic and non-periodic Cartesian C communicators C program main @@ -74,7 +74,7 @@ C print *, i, '(', outcoords(i), ')' endif endif endif - + call mpi_cart_shift( newcomm, i-1, -1, source, dest, $ ierr ) if (outcoords(i) .eq. 0) then @@ -93,10 +93,10 @@ C print *, i, '(', outcoords(i), ')' enddo call mpi_comm_free( newcomm, ierr ) endif - + enddo enddo - + call mtest_finalize( errs ) call mpi_finalize( ierr ) end diff --git a/teshsuite/smpi/mpich3-test/f77/topo/dgraph_unwgtf.f b/teshsuite/smpi/mpich3-test/f77/topo/dgraph_unwgtf.f index 23f54f26cc..0826aaedf2 100644 --- a/teshsuite/smpi/mpich3-test/f77/topo/dgraph_unwgtf.f +++ b/teshsuite/smpi/mpich3-test/f77/topo/dgraph_unwgtf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2011 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -45,7 +45,7 @@ C i.e. everyone only talks to left and right neighbors. if (src_sz .ne. 2 .or. dest_sz .ne. 2) then validate_dgraph = .false. - write(6,*) "source or destination edge array is not size 2." + write(6,*) "source or destination edge array is not size 2." write(6,"('src_sz = ',I3,', dest_sz = ',I3)") src_sz, dest_sz return endif @@ -64,7 +64,7 @@ C Check if the neighbors returned from MPI are really C the nearest neighbors that within a ring. call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr) call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr) - + do idx = 1, src_sz nbr_sep = iabs(srcs(idx) - world_rank) if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then @@ -128,7 +128,7 @@ C the nearest neighbors that within a ring. integer srcs(2), dests(2) errs = 0 - call MTEST_Init(ierr) + call MTEST_Init(ierr) call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr) call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr) @@ -153,7 +153,7 @@ C the nearest neighbors that within a ring. call MPI_Comm_free(dgraph_comm, ierr) C now create one with MPI_WEIGHTS_EMPTY -C NOTE that MPI_WEIGHTS_EMPTY was added in MPI-3 and does not +C NOTE that MPI_WEIGHTS_EMPTY was added in MPI-3 and does not C appear before then. Including this test means that this test cannot C be compiled if the MPI version is less than 3 (see the testlist file) diff --git a/teshsuite/smpi/mpich3-test/f77/topo/dgraph_wgtf.f b/teshsuite/smpi/mpich3-test/f77/topo/dgraph_wgtf.f index dd4556fd30..7520f22e57 100644 --- a/teshsuite/smpi/mpich3-test/f77/topo/dgraph_wgtf.f +++ b/teshsuite/smpi/mpich3-test/f77/topo/dgraph_wgtf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2011 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -46,7 +46,7 @@ C i.e. everyone only talks to left and right neighbors. if (src_sz .ne. 2 .or. dest_sz .ne. 2) then validate_dgraph = .false. - write(6,*) "source or destination edge array is not size 2." + write(6,*) "source or destination edge array is not size 2." write(6,"('src_sz = ',I3,', dest_sz = ',I3)") src_sz, dest_sz return endif @@ -65,7 +65,7 @@ C Check if the neighbors returned from MPI are really C the nearest neighbors that within a ring. call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr) call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr) - + do idx = 1, src_sz nbr_sep = iabs(srcs(idx) - world_rank) if (nbr_sep .ne. 1 .and. nbr_sep .ne. (world_size-1)) then @@ -142,7 +142,7 @@ C the nearest neighbors that within a ring. integer src_wgts(2), dest_wgts(2) errs = 0 - call MTEST_Init(ierr) + call MTEST_Init(ierr) call MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr) call MPI_Comm_size(MPI_COMM_WORLD, world_size, ierr) diff --git a/teshsuite/smpi/mpich3-test/f77/util/mtestf.f b/teshsuite/smpi/mpich3-test/f77/util/mtestf.f index 2c54d76f5c..f951f93c1b 100644 --- a/teshsuite/smpi/mpich3-test/f77/util/mtestf.f +++ b/teshsuite/smpi/mpich3-test/f77/util/mtestf.f @@ -1,4 +1,4 @@ -C -*- Mode: Fortran; -*- +C -*- Mode: Fortran; -*- C C (C) 2003 by Argonne National Laboratory. C See COPYRIGHT in top-level directory. @@ -30,14 +30,14 @@ C include 'mpif.h' integer errs integer rank, toterrs, ierr - + call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr ) - call MPI_Allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, - * MPI_COMM_WORLD, ierr ) - + call MPI_Allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, + * MPI_COMM_WORLD, ierr ) + if (rank .eq. 0) then - if (toterrs .gt. 0) then + if (toterrs .gt. 0) then print *, " Found ", toterrs, " errors" else print *, " No Errors" @@ -67,7 +67,7 @@ C A simple get intracomm for now else if (myindex .eq. 2) then call mpi_comm_size( MPI_COMM_WORLD, size, ierr ) call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr ) - call mpi_comm_split( MPI_COMM_WORLD, 0, size - rank, comm, + call mpi_comm_split( MPI_COMM_WORLD, 0, size - rank, comm, & ierr ) else if (min_size .eq. 1 .and. myindex .eq. 3) then @@ -112,5 +112,5 @@ C call MPI_Error_class( errcode, errclass, ierr ) call MPI_Error_string( errcode, string, slen, ierr ) print *, msg, ": Error class ", errclass, " - $ (", string(1:slen), ")" + $ (", string(1:slen), ")" end diff --git a/teshsuite/smpi/mpich3-test/f90/coll/allredint8f90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/allredint8f90.f90 index d91ec1a5bb..93acfe6a70 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/allredint8f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/allredint8f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/allredint8f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2006 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -10,14 +10,14 @@ integer errs, ierr errs = 0 - + call mtest_init( ierr ) ! ! A simple test of allreduce for the optional integer*8 type call mpi_allreduce(inbuf, outbuf, 1, MPI_INTEGER8, MPI_SUM, & & MPI_COMM_WORLD, ierr) - + call mtest_finalize( errs ) call mpi_finalize( ierr ) end diff --git a/teshsuite/smpi/mpich3-test/f90/coll/allredopttf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/allredopttf90.f90 index ffe1ffc729..1bc3e99f90 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/allredopttf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/allredopttf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/allredopttf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2007 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -12,7 +12,7 @@ integer errs, ierr errs = 0 - + call mtest_init( ierr ) call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr ) ! diff --git a/teshsuite/smpi/mpich3-test/f90/coll/alltoallvf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/alltoallvf90.f90 index 0c535e6223..cf9c505740 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/alltoallvf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/alltoallvf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/alltoallvf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2011 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -15,7 +15,7 @@ integer sbuf(maxSize), rbuf(maxSize) errs = 0 - + call mtest_init( ierr ) ! Get a comm @@ -31,7 +31,7 @@ call mpi_comm_size( comm, size, ierr ) endif call mpi_comm_rank( comm, rank, ierr ) -! +! if (size .le. maxSize) then ! Initialize the data. Just use this as an all to all ! Use the same test as alltoallwf.c , except displacements are in units of @@ -47,10 +47,10 @@ rbuf(i) = -1 enddo call mpi_alltoallv( sbuf, scounts, sdispls, stypes, & - & rbuf, rcounts, rdispls, rtypes, comm, ierr ) + & rbuf, rcounts, rdispls, rtypes, comm, ierr ) ! ! check rbuf(i) = data from the ith location of the ith send buf, or -! rbuf(i) = (i-1) * size + i +! rbuf(i) = (i-1) * size + i do i=1, size ans = (i-1) * size + rank + 1 if (rbuf(i) .ne. ans) then @@ -91,7 +91,7 @@ sbuf(1+displ) = rank displ = displ + 1 if (rank .lt. size-1) then - scounts(1+rank+1) = 1 + scounts(1+rank+1) = 1 rcounts(1+rank+1) = 1 sdispls(1+rank+1) = displ rdispls(1+rank+1) = rank+1 @@ -143,4 +143,4 @@ call mtest_finalize( errs ) call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f90/coll/alltoallwf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/alltoallwf90.f90 index 45456ba0ac..935c4d3ad1 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/alltoallwf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/alltoallwf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/alltoallwf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -14,7 +14,7 @@ integer rcounts(maxSize), rdispls(maxSize), rtypes(maxSize) integer sbuf(maxSize), rbuf(maxSize) errs = 0 - + call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) @@ -32,7 +32,7 @@ call mpi_comm_size( comm, size, ierr ) endif call mpi_comm_rank( comm, rank, ierr ) - + if (size .le. maxSize) then ! Initialize the data. Just use this as an all to all do i=1, size @@ -46,10 +46,10 @@ rbuf(i) = -1 enddo call mpi_alltoallw( sbuf, scounts, sdispls, stypes, & - & rbuf, rcounts, rdispls, rtypes, comm, ierr ) + & rbuf, rcounts, rdispls, rtypes, comm, ierr ) ! ! check rbuf(i) = data from the ith location of the ith send buf, or -! rbuf(i) = (i-1) * size + i +! rbuf(i) = (i-1) * size + i do i=1, size ans = (i-1) * size + rank + 1 if (rbuf(i) .ne. ans) then @@ -64,4 +64,4 @@ call mtest_finalize( errs ) call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f90/coll/exscanf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/exscanf90.f90 index 59cb7e447b..aeca3b5578 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/exscanf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/exscanf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/exscanf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -9,7 +9,7 @@ integer cin(*), cout(*) integer count, datatype integer i - + if (.false.) then if (datatype .ne. MPI_INTEGER) then write(6,*) 'Invalid datatype passed to user_op()' @@ -32,7 +32,7 @@ allocate(inbuf(2), STAT=status) allocate(outbuf(2), STAT=status) errs = 0 - + call mtest_init( ierr ) ! ! A simple test of exscan @@ -59,7 +59,7 @@ endif endif ! -! Try a user-defined operation +! Try a user-defined operation ! call mpi_op_create( uop, .true., sumop, ierr ) inbuf(1) = rank @@ -80,7 +80,7 @@ endif endif call mpi_op_free( sumop, ierr ) - + ! ! Try a user-defined operation (and don't claim it is commutative) ! diff --git a/teshsuite/smpi/mpich3-test/f90/coll/inplacef90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/inplacef90.f90 index e9716cf86c..18019c2039 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/inplacef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/inplacef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/inplacef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2005 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -15,7 +15,7 @@ integer MAX_SIZE parameter (MAX_SIZE=1024) integer rbuf(MAX_SIZE), rdispls(MAX_SIZE), rcount(MAX_SIZE), & - & sbuf(MAX_SIZE) + & sbuf(MAX_SIZE) errs = 0 call mtest_init( ierr ) @@ -37,13 +37,13 @@ if (rbuf(i) .ne. i-1) then errs = errs + 1 print *, '[',rank,'] rbuf(', i, ') = ', rbuf(i), & - & ' in gather' + & ' in gather' endif enddo else call mpi_gather( rank, 1, MPI_INTEGER, rbuf, 1, MPI_INTEGER, & & root, comm, ierr ) - endif + endif ! Gatherv with inplace do i=1,size @@ -65,7 +65,7 @@ else call mpi_gatherv( rank, 1, MPI_INTEGER, rbuf, rcount, rdispls, & & MPI_INTEGER, root, comm, ierr ) - endif + endif ! Scatter with inplace do i=1,size @@ -81,9 +81,9 @@ if (rbuf(1) .ne. rank+1) then errs = errs + 1 print *, '[', rank, '] rbuf = ', rbuf(1), & - & ' in scatter' + & ' in scatter' endif - endif + endif call mtest_finalize( errs ) call mpi_finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f90/coll/nonblocking_inpf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/nonblocking_inpf90.f90 index c9aed02a3c..b6d44a645e 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/nonblocking_inpf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/nonblocking_inpf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/nonblocking_inpf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/coll/nonblockingf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/nonblockingf90.f90 index a07df71d8b..51dda009a3 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/nonblockingf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/nonblockingf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/nonblockingf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -25,7 +25,7 @@ comm = MPI_COMM_WORLD call MPI_Comm_size(comm, size, ierr) call MPI_Comm_rank(comm, rank, ierr) -! +! do ii = 1, size sbuf(2*ii-1) = ii sbuf(2*ii) = ii diff --git a/teshsuite/smpi/mpich3-test/f90/coll/red_scat_blockf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/red_scat_blockf90.f90 index 35a1546e3d..52a5778067 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/red_scat_blockf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/red_scat_blockf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/red_scat_blockf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/coll/redscatf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/redscatf90.f90 index 496d178277..258f33bc4e 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/redscatf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/redscatf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/redscatf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2011 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -9,7 +9,7 @@ integer cin(*), cout(*) integer count, datatype integer i - + if (.false.) then if (datatype .ne. MPI_INTEGER) then write(6,*) 'Invalid datatype ',datatype,' passed to user_op()' @@ -24,7 +24,7 @@ ! ! Test of reduce scatter. ! -! Each processor contributes its rank + the index to the reduction, +! Each processor contributes its rank + the index to the reduction, ! then receives the ith sum ! ! Can be called with any number of processors. @@ -63,7 +63,7 @@ & MPI_INTEGER, MPI_SUM, comm, ierr ) sumval = size * rank + ((size - 1) * size)/2 -! recvbuf should be size * (rank + i) +! recvbuf should be size * (rank + i) if (recvbuf .ne. sumval) then errs = errs + 1 print *, "Did not get expected value for reduce scatter" @@ -75,7 +75,7 @@ & MPI_INTEGER, sumop, comm, ierr ) sumval = size * rank + ((size - 1) * size)/2 -! recvbuf should be size * (rank + i) +! recvbuf should be size * (rank + i) if (recvbuf .ne. sumval) then errs = errs + 1 print *, "sumop: Did not get expected value for reduce scatter" diff --git a/teshsuite/smpi/mpich3-test/f90/coll/reducelocalf90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/reducelocalf90.f90 index 14229525b9..4bb626872d 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/reducelocalf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/reducelocalf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/reducelocalf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2009 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -17,7 +17,7 @@ write(6,*) 'Invalid datatype passed to user_op()' return endif - + do ii=1, count outvec(ii) = invec(ii) * 2 + outvec(ii) enddo @@ -33,7 +33,7 @@ integer ierr, errs integer count, myop integer ii - + errs = 0 call mtest_init(ierr) @@ -43,7 +43,7 @@ do ii = 1,count vin(ii) = ii vout(ii) = ii - enddo + enddo call mpi_reduce_local( vin, vout, count, & & MPI_INTEGER, MPI_SUM, ierr ) ! Check if the result is correct @@ -54,7 +54,7 @@ if ( vout(ii) .ne. 2*ii ) then errs = errs + 1 endif - enddo + enddo if ( count .gt. 0 ) then count = count + count else @@ -65,7 +65,7 @@ call mpi_op_create( user_op, .false., myop, ierr ) count = 0 - do while (count .le. max_buf_size) + do while (count .le. max_buf_size) do ii = 1, count vin(ii) = ii vout(ii) = ii diff --git a/teshsuite/smpi/mpich3-test/f90/coll/uallreducef90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/uallreducef90.f90 index 574d6490de..45e873462c 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/uallreducef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/uallreducef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/uallreducef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -12,7 +12,7 @@ integer cin(*), cout(*) integer count, datatype integer i - + if (datatype .ne. MPI_INTEGER) then print *, 'Invalid datatype (',datatype,') passed to user_op()' return @@ -31,7 +31,7 @@ integer, DIMENSION(:), ALLOCATABLE :: vin, vout integer comm integer status - + errs = 0 ALLOCATE(vin(65000), STAT=status) ALLOCATE(vout(65000), STAT=status) @@ -42,7 +42,7 @@ comm = MPI_COMM_WORLD call mpi_comm_size( comm, size, ierr ) count = 1 - do while (count .lt. 65000) + do while (count .lt. 65000) do i=1, count vin(i) = i vout(i) = -1 diff --git a/teshsuite/smpi/mpich3-test/f90/coll/vw_inplacef90.f90 b/teshsuite/smpi/mpich3-test/f90/coll/vw_inplacef90.f90 index 192cb02b6b..850a83fb57 100644 --- a/teshsuite/smpi/mpich3-test/f90/coll/vw_inplacef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/coll/vw_inplacef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/coll/vw_inplacef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/allctypesf90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/allctypesf90.f90 index a15061855e..d7ef32ff16 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/allctypesf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/allctypesf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/allctypesf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2004 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -81,7 +81,7 @@ call checkdtype( MPI_C_LONG_DOUBLE_COMPLEX, & & "MPI_C_LONG_DOUBLE_COMPLEX", ierr ) endif -! address/offset types +! address/offset types call checkdtype( MPI_AINT, "MPI_AINT", ierr ) call checkdtype( MPI_OFFSET, "MPI_OFFSET", ierr ) endif @@ -97,7 +97,7 @@ character *(*) name integer ir, rlen character *(MPI_MAX_OBJECT_NAME) outname -! +! outname = "" call MPI_TYPE_GET_NAME( intype, outname, rlen, ir ) if (ir .ne. MPI_SUCCESS) then @@ -110,7 +110,7 @@ ierr = ierr + 1 endif endif - + return end ! @@ -121,7 +121,7 @@ character *(*) name, name2 integer ir, rlen character *(MPI_MAX_OBJECT_NAME) outname -! +! outname = "" call MPI_TYPE_GET_NAME( intype, outname, rlen, ir ) if (ir .ne. MPI_SUCCESS) then @@ -134,6 +134,6 @@ ierr = ierr + 1 endif endif - + return end diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/createf90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/createf90.f90 index 7672858202..0ac1602a36 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/createf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/createf90.f90 @@ -1,4 +1,4 @@ -! +! ! (C) 2004 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! @@ -47,7 +47,7 @@ print *, "parameter was ", nparms(1), " should be 9" endif endif - + call mpi_type_create_f90_integer( 8, ntype2, ierr ) if (ntype1 .eq. ntype2) then errs = errs + 1 @@ -64,5 +64,5 @@ call mtest_finalize( errs ) call mpi_finalize( ierr ) - + end diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/gaddressf90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/gaddressf90.f90 index bf23687563..41e4fff603 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/gaddressf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/gaddressf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/gaddressf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! ! (C) 2003 by Argonne National Laboratory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_d.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_d.f90 index 00c112347f..8a6dd9c8bd 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_d.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_d.f90 @@ -1,4 +1,4 @@ -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2013 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_u.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_u.f90 index aa9f8feaaa..c7a745c19d 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_u.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/get_elem_u.f90 @@ -1,4 +1,4 @@ -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2013 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -9,9 +9,9 @@ PROGRAM get_elem_u - USE mpi - IMPLICIT NONE - INTEGER RANK, SIZE, IERR, COMM, errs + USE mpi + IMPLICIT NONE + INTEGER RANK, SIZE, IERR, COMM, errs INTEGER MAX, I, K, dest INTEGER STATUS(MPI_STATUS_SIZE) @@ -24,31 +24,31 @@ PROGRAM get_elem_u INTEGER :: type1, type2, extent REAL :: a(amax) - errs = 0 - CALL MPI_Init( ierr ) - COMM = MPI_COMM_WORLD - CALL MPI_Comm_rank(COMM,RANK,IERR) - CALL MPI_Comm_size(COMM,SIZE,IERR) + errs = 0 + CALL MPI_Init( ierr ) + COMM = MPI_COMM_WORLD + CALL MPI_Comm_rank(COMM,RANK,IERR) + CALL MPI_Comm_size(COMM,SIZE,IERR) dest=size-1 CALL MPI_Type_create_struct(nb, blklen, disp, types, type1, ierr) CALL MPI_Type_commit(type1, ierr) CALL MPI_Type_extent(type1, extent, ierr) - CALL MPI_Type_contiguous(4, Type1, Type2, ierr) - CALL MPI_Type_commit(Type2, ierr) + CALL MPI_Type_contiguous(4, Type1, Type2, ierr) + CALL MPI_Type_commit(Type2, ierr) CALL MPI_Type_extent(Type2, extent, ierr) DO k=1,17 - IF(rank .EQ. 0) THEN + IF(rank .EQ. 0) THEN ! send k copies of datatype Type1 - CALL MPI_Send(a, k, Type1, dest, 0, comm, ierr) + CALL MPI_Send(a, k, Type1, dest, 0, comm, ierr) ELSE IF (rank == dest) THEN - CALL MPI_Recv(a, 200, Type2, 0, 0, comm, status, ierr) + CALL MPI_Recv(a, 200, Type2, 0, 0, comm, status, ierr) CALL MPI_Get_elements(status, Type2, i, ierr) IF (i .NE. 2*k) THEN errs = errs+1 diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/hindex1f90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/hindex1f90.f90 index 7941ced3c5..4b96068c2c 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/hindex1f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/hindex1f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/hindex1f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! ! (C) 2011 by Argonne National Laboratory. @@ -14,19 +14,19 @@ integer inbuf(bufsize), outbuf(bufsize), packbuf(bufsize) integer position, len, psize ! -! Test for hindexed; -! +! Test for hindexed; +! errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - + do i=1, 10 displs(i) = (10-i)*intsize counts(i) = 1 enddo call mpi_type_hindexed( 10, counts, displs, MPI_INTEGER, dtype, & - & ierr ) + & ierr ) call mpi_type_commit( dtype, ierr ) ! call mpi_pack_size( 1, dtype, MPI_COMM_WORLD, psize, ierr ) @@ -45,7 +45,7 @@ position = 0 call mpi_unpack( packbuf, len, position, outbuf, 10, & & MPI_INTEGER, MPI_COMM_WORLD, ierr ) -! +! do i=1, 10 if (outbuf(i) .ne. 11-i) then errs = errs + 1 diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/indtype.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/indtype.f90 index 3d05a6b63a..2dbf38eb68 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/indtype.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/indtype.f90 @@ -1,4 +1,4 @@ -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -17,7 +17,7 @@ double precision,dimension(:,:),allocatable :: sndbuf, rcvbuf logical verbose - verbose = .false. + verbose = .false. call mtest_init ( ierr ) call mpi_comm_size( MPI_COMM_WORLD, size, ierr ) call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr ) @@ -42,10 +42,10 @@ enddo ! bug occurs when first two displacements are 0 - displs(1) = 0 - displs(2) = 0 + displs(1) = 0 + displs(2) = 0 displs(3) = 10 - displs(4) = 10 + displs(4) = 10 call mpi_type_indexed( count, blocklens, displs*blocklens(1), & & MPI_DOUBLE_PRECISION, type, ierr ) @@ -59,7 +59,7 @@ call mpi_send( sndbuf(1,1), 1, type, 1, 0, MPI_COMM_WORLD,ierr ) else if (rank .eq. 1) then - + xfersize=count * blocklens(1) call mpi_recv( rcvbuf(1,1), xfersize, MPI_DOUBLE_PRECISION, 0, 0, & & MPI_COMM_WORLD,status, ierr ) diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/kinds.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/kinds.f90 index fd22c58aff..d4437e3e34 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/kinds.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/kinds.f90 @@ -1,4 +1,4 @@ -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2011 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -59,7 +59,7 @@ call MPI_SEND( aint, 1, MPI_AINT, 1, 0, MPI_COMM_WORLD, ierr ) call MPI_SEND( oint, 1, MPI_OFFSET, 1, 1, MPI_COMM_WORLD, ierr ) call MPI_SEND( iint, 1, MPI_INTEGER, 1, 2, MPI_COMM_WORLD, ierr ) -! +! else if (wrank .eq. 1) then if (range(taint) .ge. 10) then taint = 1 diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/packef90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/packef90.f90 index 801f1aafcf..b2b2832d40 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/packef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/packef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/packef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -24,27 +24,27 @@ pbufsize = 1000 * intsize call mpi_pack_external_size( 'external32', 10, MPI_INTEGER, & - & aint, ierr ) + & aint, ierr ) if (aint .ne. 10 * 4) then errs = errs + 1 print *, 'Expected 40 for size of 10 external32 integers', & & ', got ', aint endif call mpi_pack_external_size( 'external32', 10, MPI_LOGICAL, & - & aint, ierr ) + & aint, ierr ) if (aint .ne. 10 * 4) then errs = errs + 1 print *, 'Expected 40 for size of 10 external32 logicals', & & ', got ', aint endif call mpi_pack_external_size( 'external32', 10, MPI_CHARACTER, & - & aint, ierr ) + & aint, ierr ) if (aint .ne. 10 * 1) then errs = errs + 1 print *, 'Expected 10 for size of 10 external32 characters', & & ', got ', aint endif - + call mpi_pack_external_size( 'external32', 3, MPI_INTEGER2, & & aint, ierr ) if (aint .ne. 3 * 2) then @@ -113,7 +113,7 @@ aintv(1) = pbufsize aintv(2) = 0 aintv(3) = 0 -! One MPI implementation failed to increment the position; instead, +! One MPI implementation failed to increment the position; instead, ! it set the value with the amount of data packed in this call ! We use aintv(3) to detect and report this specific error call mpi_pack_external( 'external32', inbuf, insize, MPI_INTEGER, & @@ -166,7 +166,7 @@ do i=1, rsize if (routbuf(i) .ne. 1000.0 * i) then errs = errs + 1 - print *, 'routbuf(',i,') = ', routbuf(i), ' expected ', & + print *, 'routbuf(',i,') = ', routbuf(i), ' expected ', & & 1000.0 * i endif enddo diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/sizeof.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/sizeof.f90 index 7ace5f2c4f..c7ce80d413 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/sizeof.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/sizeof.f90 @@ -1,9 +1,9 @@ -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2007 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! -! This program tests that the MPI_SIZEOF routine is implemented for the +! This program tests that the MPI_SIZEOF routine is implemented for the ! predefined scalar Fortran types. It confirms that the size of these ! types matches the size of the corresponding MPI datatypes. ! diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/structf.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/structf.f90 index b2118b69b5..32f77762f9 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/structf.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/structf.f90 @@ -1,8 +1,8 @@ -! +! ! (C) 2004 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! -! Thanks to +! Thanks to ! William R. Magro ! for this test ! @@ -17,7 +17,7 @@ use mpi implicit none - + integer comm integer newtype integer me @@ -72,7 +72,7 @@ call mpi_send(MPI_BOTTOM,1,newtype,dest,1,comm,ierr) call mpi_type_free(newtype,ierr) ! write(*,*) "Sent ",name(1:5),x - else + else ! Everyone calls barrier in case size > 2 call mpi_barrier( MPI_COMM_WORLD, ierr ) if (me.eq.dest) then @@ -82,7 +82,7 @@ x = 0.0d0 call mpi_recv(buf,bufsize,MPI_PACKED, src, & & 1, comm, status, ierr) - + call mpi_unpack(buf,bufsize,position, & & name,5,MPI_CHARACTER, comm,ierr) call mpi_unpack(buf,bufsize,position, & diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/trf90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/trf90.f90 index 946e4cdd46..ec0d8011a0 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/trf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/trf90.f90 @@ -1,4 +1,4 @@ -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2011 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/typecntsf90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/typecntsf90.f90 index 8eb870a891..727d3e580c 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/typecntsf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/typecntsf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/typecntsf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -10,7 +10,7 @@ integer ntype1, ntype2 ! ! This is a very simple test that just tests that the contents/envelope -! routines can be called. This should be upgraded to test the new +! routines can be called. This should be upgraded to test the new ! MPI-2 datatype routines (which use address-sized integers) ! @@ -26,7 +26,7 @@ call explore( ntype2, MPI_COMBINER_DUP, errs ) call mpi_type_free( ntype2, ierr ) call mpi_type_free( ntype1, ierr ) - + ! call mtest_finalize( errs ) call mpi_finalize( ierr ) @@ -86,6 +86,6 @@ errs = errs + 1 print *, ' Unknown combiner ', combiner endif - + return end diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/typem2f90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/typem2f90.f90 index c5eb8e535e..63630abaf5 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/typem2f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/typem2f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/typem2f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/typename3f90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/typename3f90.f90 index 4e91774ec7..926a3c7b06 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/typename3f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/typename3f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/typename3f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! ! (C) 2012 by Argonne National Laboratory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/typenamef90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/typenamef90.f90 index eda12ddf49..c44ccda7b0 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/typenamef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/typenamef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/typenamef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! ! (C) 2003 by Argonne National Laboratory. diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/typesnamef90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/typesnamef90.f90 index 27f6a0335d..c7cca61c23 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/typesnamef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/typesnamef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/typesnamef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -11,7 +11,7 @@ integer ntype1, ntype2, errs, ierr errs = 0 - + call MTest_Init( ierr ) call mpi_type_vector( 10, 1, 100, MPI_INTEGER, ntype1, ierr ) @@ -57,10 +57,10 @@ errs = errs + 1 print *, ' (type2) Datatype name is not all blank' endif - + call mpi_type_free( ntype1, ierr ) call mpi_type_free( ntype2, ierr ) - + call MTest_Finalize( errs ) call MPI_Finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f90/datatype/typesubf90.f90 b/teshsuite/smpi/mpich3-test/f90/datatype/typesubf90.f90 index aea04d9029..1c67e7fb1f 100644 --- a/teshsuite/smpi/mpich3-test/f90/datatype/typesubf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/datatype/typesubf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/datatype/typesubf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. diff --git a/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 b/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 index d3f6091e74..8909b8038e 100644 --- a/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/info/infotest2f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/info/infotest2f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -23,7 +23,7 @@ errs = 0 call mtest_init( ierr ) - + ! Note that the MPI standard requires that leading an trailing blanks ! are stripped from keys and values (Section 4.10, The Info Object) ! @@ -107,13 +107,13 @@ if (flag) then errs = errs + 1 print *, ' Found unexpected key in MPI_Info_get ', keys(i) - else + else if (myvalue .ne. 'A test') then errs = errs + 1 print *, ' Returned value overwritten, is now ', myvalue endif endif - + enddo do i=3,6 myvalue = ' ' @@ -122,7 +122,7 @@ if (.not. flag) then errs = errs + 1 print *, ' Did not find key ', keys(i) - else + else if (myvalue .ne. values(i)) then errs = errs + 1 print *, ' Found wrong value (', myvalue, ') for key ', & diff --git a/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 b/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 index 05419ab748..10b5ed6c3e 100644 --- a/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/info/infotestf90.f90 @@ -1,10 +1,10 @@ ! This file created from test/mpi/f77/info/infotestf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! -! Simple info test +! Simple info test program main use mpi integer i1, i2 @@ -34,12 +34,12 @@ if (.not. flag ) then print *, "Did not find key1 in info1" errs = errs + 1 - else + else if (value .ne. "value1") then print *, "Found wrong value (", value, "), expected value1" errs = errs + 1 else -! check for trailing blanks +! check for trailing blanks do i=7,valuelen if (value(i:i) .ne. " ") then print *, "Found non blank in info value" diff --git a/teshsuite/smpi/mpich3-test/f90/init/baseenvf90.f90 b/teshsuite/smpi/mpich3-test/f90/init/baseenvf90.f90 index a206c430fb..210a9ebd42 100644 --- a/teshsuite/smpi/mpich3-test/f90/init/baseenvf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/init/baseenvf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/init/baseenvf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -63,7 +63,7 @@ errs = errs + 1 print *, 'is_thread_main returned false for main thread' endif - + call mpi_query_thread( qprovided, ierr ) if (qprovided .ne. provided) then errs = errs + 1 @@ -80,7 +80,7 @@ endif if (rank .eq. 0) then - if (errs .eq. 0) then + if (errs .eq. 0) then print *, ' No Errors' else print *, ' Found ', errs, ' errors' diff --git a/teshsuite/smpi/mpich3-test/f90/pt2pt/allpairf90.f90 b/teshsuite/smpi/mpich3-test/f90/pt2pt/allpairf90.f90 index c20238bce1..325378efc9 100644 --- a/teshsuite/smpi/mpich3-test/f90/pt2pt/allpairf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/pt2pt/allpairf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/pt2pt/allpairf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -14,7 +14,7 @@ logical mtestGetIntraComm logical verbose common /flags/ verbose - + errs = 0 verbose = .false. ! verbose = .true. @@ -35,7 +35,7 @@ call test_pair_sendrecvrepl( comm, errs ) call mtestFreeComm( comm ) enddo -! +! call MTest_Finalize( errs ) call MPI_Finalize(ierr) ! @@ -74,7 +74,7 @@ call init_test_data(send_buf,TEST_SIZE) ! call MPI_Send(send_buf, count, MPI_REAL, next, tag, & - & comm, ierr) + & comm, ierr) ! call MPI_Recv(recv_buf, TEST_SIZE, MPI_REAL, & & MPI_ANY_SOURCE, MPI_ANY_TAG, comm, status, ierr) @@ -88,7 +88,7 @@ call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, & & 'send and recv', errs ) ! - call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr) + call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, comm, ierr) end if ! end @@ -123,16 +123,16 @@ call clear_test_data(recv_buf,TEST_SIZE) ! if (rank .eq. 0) then -! +! call init_test_data(send_buf,TEST_SIZE) ! call MPI_Recv( MPI_BOTTOM, 0, MPI_INTEGER, next, tag, & & comm, status, ierr ) ! call MPI_Rsend(send_buf, count, MPI_REAL, next, tag, & - & comm, ierr) + & comm, ierr) ! - call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr) + call MPI_Probe(MPI_ANY_SOURCE, tag, comm, status, ierr) ! if (status(MPI_SOURCE) .ne. next) then print *, 'Rsend: Incorrect source, expected', next, & @@ -173,7 +173,7 @@ & 'rsend and recv', errs ) ! call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, & - & comm, ierr) + & comm, ierr) end if ! end @@ -213,7 +213,7 @@ call init_test_data(send_buf,TEST_SIZE) ! call MPI_Iprobe(MPI_ANY_SOURCE, tag, & - & comm, flag, status, ierr) + & comm, flag, status, ierr) ! if (flag) then print *, 'Ssend: Iprobe succeeded! source', & @@ -223,13 +223,13 @@ end if ! call MPI_Ssend(send_buf, count, MPI_REAL, next, tag, & - & comm, ierr) + & comm, ierr) ! do while (.not. flag) call MPI_Iprobe(MPI_ANY_SOURCE, tag, & - & comm, flag, status, ierr) + & comm, flag, status, ierr) end do -! +! if (status(MPI_SOURCE) .ne. next) then print *, 'Ssend: Incorrect source, expected', next, & & ', got', status(MPI_SOURCE) @@ -255,7 +255,7 @@ & status, ierr) ! call msg_check( recv_buf, next, tag, count, status, & - & TEST_SIZE, 'ssend and recv', errs ) + & TEST_SIZE, 'ssend and recv', errs ) ! else if (prev .eq. 0) then ! @@ -267,7 +267,7 @@ & 'ssend and recv', errs ) ! call MPI_Ssend(recv_buf, count, MPI_REAL, prev, tag, & - & comm, ierr) + & comm, ierr) end if ! end @@ -311,7 +311,7 @@ call init_test_data(send_buf,TEST_SIZE) ! call MPI_Isend(send_buf, count, MPI_REAL, next, tag, & - & comm, requests(2), ierr) + & comm, requests(2), ierr) ! call MPI_Waitall(2, requests, statuses, ierr) ! @@ -330,7 +330,7 @@ & 'isend and irecv', errs ) ! call MPI_Isend(recv_buf, count, MPI_REAL, prev, tag, & - & comm, requests(1), ierr) + & comm, requests(1), ierr) ! call MPI_Wait(requests(1), status, ierr) ! @@ -386,7 +386,7 @@ & dupcom, status, ierr ) ! call MPI_Irsend(send_buf, count, MPI_REAL, next, tag, & - & comm, requests(2), ierr) + & comm, requests(2), ierr) ! index = -1 do while (index .ne. 1) @@ -419,7 +419,7 @@ & 'irsend and irecv', errs ) ! call MPI_Irsend(recv_buf, count, MPI_REAL, prev, tag, & - & comm, requests(1), ierr) + & comm, requests(1), ierr) ! call MPI_Waitall(1, requests, statuses, ierr) ! @@ -471,7 +471,7 @@ call init_test_data(send_buf,TEST_SIZE) ! call MPI_Issend(send_buf, count, MPI_REAL, next, tag, & - & comm, requests(2), ierr) + & comm, requests(2), ierr) ! flag = .FALSE. do while (.not. flag) @@ -493,7 +493,7 @@ & 'issend and recv', errs ) call MPI_Issend(recv_buf, count, MPI_REAL, prev, tag, & - & comm, requests(1), ierr) + & comm, requests(1), ierr) ! flag = .FALSE. do while (.not. flag) @@ -544,9 +544,9 @@ call init_test_data(send_buf,TEST_SIZE) ! call MPI_Send_init(send_buf, count, MPI_REAL, next, tag, & - & comm, requests(1), ierr) + & comm, requests(1), ierr) ! - call MPI_Startall(2, requests, ierr) + call MPI_Startall(2, requests, ierr) call MPI_Waitall(2, requests, statuses, ierr) ! call msg_check( recv_buf, next, tag, count, statuses(1,2), & @@ -557,8 +557,8 @@ else if (prev .eq. 0) then ! call MPI_Send_init(send_buf, count, MPI_REAL, prev, tag, & - & comm, requests(1), ierr) - call MPI_Start(requests(2), ierr) + & comm, requests(1), ierr) + call MPI_Start(requests(2), ierr) call MPI_Wait(requests(2), status, ierr) ! call msg_check( recv_buf, prev, tag, count, status, TEST_SIZE, & @@ -568,7 +568,7 @@ send_buf(i) = recv_buf(i) end do ! - call MPI_Start(requests(1), ierr) + call MPI_Start(requests(1), ierr) call MPI_Wait(requests(1), status, ierr) ! call MPI_Request_free(requests(1), ierr) @@ -617,7 +617,7 @@ if (rank .eq. 0) then ! call MPI_Rsend_init(send_buf, count, MPI_REAL, next, tag, & - & comm, requests(1), ierr) + & comm, requests(1), ierr) ! call init_test_data(send_buf,TEST_SIZE) ! @@ -644,7 +644,7 @@ else if (prev .eq. 0) then ! call MPI_Rsend_init(send_buf, count, MPI_REAL, prev, tag, & - & comm, requests(1), ierr) + & comm, requests(1), ierr) ! call MPI_Start(requests(2), ierr) ! @@ -711,7 +711,7 @@ if (rank .eq. 0) then ! call MPI_Ssend_init(send_buf, count, MPI_REAL, next, tag, & - & comm, requests(2), ierr) + & comm, requests(2), ierr) ! call init_test_data(send_buf,TEST_SIZE) ! @@ -735,7 +735,7 @@ else if (prev .eq. 0) then ! call MPI_Ssend_init(send_buf, count, MPI_REAL, prev, tag, & - & comm, requests(2), ierr) + & comm, requests(2), ierr) ! call MPI_Start(requests(1), ierr) ! @@ -798,7 +798,7 @@ call MPI_Sendrecv(send_buf, count, MPI_REAL, next, tag, & & recv_buf, count, MPI_REAL, next, tag, & - & comm, status, ierr) + & comm, status, ierr) call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, & & 'sendrecv', errs ) @@ -813,7 +813,7 @@ & 'recv/send', errs ) call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, & - & comm, ierr) + & comm, ierr) end if ! end @@ -854,7 +854,7 @@ ! call MPI_Sendrecv_replace(recv_buf, count, MPI_REAL, & & next, tag, next, tag, & - & comm, status, ierr) + & comm, status, ierr) call msg_check( recv_buf, next, tag, count, status, TEST_SIZE, & & 'sendrecvreplace', errs ) @@ -871,7 +871,7 @@ & 'recv/send for replace', errs ) call MPI_Send(recv_buf, count, MPI_REAL, prev, tag, & - & comm, ierr) + & comm, ierr) end if ! end @@ -917,7 +917,7 @@ errs = errs + 1 foundError = .true. end if - + call verify_test_data(recv_buf, count, n, name, errs ) end @@ -937,7 +937,7 @@ print *, 'Nonnull request in ', msg endif 10 continue -! +! end !------------------------------------------------------------------------------ ! @@ -995,14 +995,14 @@ errs = errs + 1 endif 20 continue -! +! 100 format('Invalid data', f6.1, ' at ', i4, ' of ', i4, ' in ', a) ! end ! -! This routine is used to prevent the compiler from deallocating the -! array "a", which may happen in some of the tests (see the text in -! the MPI standard about why this may be a problem in valid Fortran +! This routine is used to prevent the compiler from deallocating the +! array "a", which may happen in some of the tests (see the text in +! the MPI standard about why this may be a problem in valid Fortran ! codes). Without this, for example, tests fail with the Cray ftn ! compiler. ! diff --git a/teshsuite/smpi/mpich3-test/f90/pt2pt/dummyf90.f90 b/teshsuite/smpi/mpich3-test/f90/pt2pt/dummyf90.f90 index 4db2b95782..e2e92db803 100644 --- a/teshsuite/smpi/mpich3-test/f90/pt2pt/dummyf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/pt2pt/dummyf90.f90 @@ -1,15 +1,15 @@ ! This file created from test/mpi/f77/pt2pt/dummyf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2010 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! ! ! This file is used to disable certain compiler optimizations that -! can cause incorrect results with the test in greqf.f. It provides a +! can cause incorrect results with the test in greqf.f. It provides a ! point where extrastate may be modified, limiting the compilers ability ! to move code around. -! The include of mpif.h is not needed in the F77 case but in the +! The include of mpif.h is not needed in the F77 case but in the ! F90 case it is, because in that case, extrastate is defined as an ! integer (kind=MPI_ADDRESS_KIND), and the script that creates the ! F90 tests from the F77 tests looks for mpif.h diff --git a/teshsuite/smpi/mpich3-test/f90/pt2pt/greqf90.f90 b/teshsuite/smpi/mpich3-test/f90/pt2pt/greqf90.f90 index e82027eab8..773897b6c0 100644 --- a/teshsuite/smpi/mpich3-test/f90/pt2pt/greqf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/pt2pt/greqf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/pt2pt/greqf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -33,7 +33,7 @@ ! extrastate = extrastate - 1 ! The value returned by the free function is the error code -! returned by the wait/test function +! returned by the wait/test function ierr = MPI_SUCCESS end ! @@ -54,10 +54,10 @@ ! MPI_Grequest_complete function would be called from another routine, ! often running in a separate thread. This simple code allows us to ! check that requests can be created, tested, and waited on in the -! case where the request is complete before the wait is called. +! case where the request is complete before the wait is called. ! ! Note that MPI did *not* define a routine that can be called within -! test or wait to advance the state of a generalized request. +! test or wait to advance the state of a generalized request. ! Most uses of generalized requests will need to use a separate thread. ! program main @@ -74,7 +74,7 @@ errs = 0 freefncall = 0 - + call MTest_Init( ierr ) extrastate = 0 @@ -85,7 +85,7 @@ errs = errs + 1 print *, 'Generalized request marked as complete' endif - + call mpi_grequest_complete( request, ierr ) call MPI_Wait( request, status, ierr ) @@ -95,15 +95,15 @@ & extrastate, request, ierr ) call mpi_grequest_complete( request, ierr ) call mpi_wait( request, MPI_STATUS_IGNORE, ierr ) -! -! The following routine may prevent an optimizing compiler from +! +! The following routine may prevent an optimizing compiler from ! just remembering that extrastate was set in grequest_start call dummyupdate(extrastate) if (extrastate .ne. 0) then errs = errs + 1 if (freefncall .eq. 0) then print *, 'Free routine not called' - else + else print *, 'Free routine did not update extra_data' print *, 'extrastate = ', extrastate endif diff --git a/teshsuite/smpi/mpich3-test/f90/pt2pt/mprobef90.f90 b/teshsuite/smpi/mpich3-test/f90/pt2pt/mprobef90.f90 index 0ba759b0a1..cd760ed067 100644 --- a/teshsuite/smpi/mpich3-test/f90/pt2pt/mprobef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/pt2pt/mprobef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/pt2pt/mprobef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2012 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,20 +18,20 @@ call mpi_init( ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, ' Unexpected return from MPI_INIT', ierr + print *, ' Unexpected return from MPI_INIT', ierr endif call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr ) call mpi_comm_size( MPI_COMM_WORLD, size, ierr ) if (size .lt. 2) then errs = errs + 1 - print *, ' This test requires at least 2 processes' -! Abort now - do not continue in this case. + print *, ' This test requires at least 2 processes' +! Abort now - do not continue in this case. call mpi_abort( MPI_COMM_WORLD, 1, ierr ) endif if (size .gt. 2) then print *, ' This test is running with ', size, ' processes,' - print *, ' only 2 processes are used.' + print *, ' only 2 processes are used.' endif ! Test 0: simple Send and Mprobe+Mrecv. @@ -152,7 +152,7 @@ if (rreq .eq. MPI_REQUEST_NULL) then errs = errs + 1 print *, 'rreq is unmodified at T1 Imrecv().' - endif + endif call MPI_Wait(rreq, s2, ierr) if (recvbuf(1) .ne. 1735928559) then errs = errs + 1 @@ -306,7 +306,7 @@ if (rreq .eq. MPI_REQUEST_NULL) then errs = errs + 1 print *, 'rreq is unmodified at T3 Imrecv().' - endif + endif call MPI_Wait(rreq, s2, ierr) if (recvbuf(1) .ne. 1735928559) then errs = errs + 1 diff --git a/teshsuite/smpi/mpich3-test/f90/pt2pt/statusesf90.f90 b/teshsuite/smpi/mpich3-test/f90/pt2pt/statusesf90.f90 index 940555464a..ca8c6ba5e2 100644 --- a/teshsuite/smpi/mpich3-test/f90/pt2pt/statusesf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/pt2pt/statusesf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/pt2pt/statusesf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,14 +18,14 @@ call mpi_init( ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_INIT', ierr + print *, 'Unexpected return from MPI_INIT', ierr endif ierr = -1 call mpi_comm_rank( MPI_COMM_WORLD, rank, ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_COMM_WORLD', ierr + print *, 'Unexpected return from MPI_COMM_WORLD', ierr endif do i=1, nreqs, 2 ierr = -1 @@ -33,14 +33,14 @@ & MPI_COMM_WORLD, reqs(i), ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_ISEND', ierr + print *, 'Unexpected return from MPI_ISEND', ierr endif ierr = -1 call mpi_irecv( MPI_BOTTOM, 0, MPI_BYTE, rank, i, & & MPI_COMM_WORLD, reqs(i+1), ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_IRECV', ierr + print *, 'Unexpected return from MPI_IRECV', ierr endif enddo @@ -48,7 +48,7 @@ call mpi_waitall( nreqs, reqs, MPI_STATUSES_IGNORE, ierr ) if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 - print *, 'Unexpected return from MPI_WAITALL', ierr + print *, 'Unexpected return from MPI_WAITALL', ierr endif call mtest_finalize( errs ) diff --git a/teshsuite/smpi/mpich3-test/f90/rma/baseattrwinf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/baseattrwinf90.f90 index 957d8a2dc1..daba2dcee6 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/baseattrwinf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/baseattrwinf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/baseattrwinf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -19,11 +19,11 @@ errs = 0 - + call mtest_init( ierr ) call mpi_comm_size( MPI_COMM_WORLD, commsize, ierr ) -! Create a window; then extract the values +! Create a window; then extract the values asize = 1024 disp = 4 call MPI_Win_create( base, asize, disp, MPI_INFO_NULL, & @@ -36,8 +36,8 @@ errs = errs + 1 print *, "Could not get WIN_BASE" ! -! There is no easy way to get the actual value of base to compare -! against. MPI_Address gives a value relative to MPI_BOTTOM, which +! There is no easy way to get the actual value of base to compare +! against. MPI_Address gives a value relative to MPI_BOTTOM, which ! is different from 0 in Fortran (unless you can define MPI_BOTTOM ! as something like %pointer(0)). ! else @@ -46,7 +46,7 @@ ! call MPI_Address( base, baseadd, ierr ) ! if (valout .ne. baseadd) then ! errs = errs + 1 -! print *, "Got incorrect value for WIN_BASE (", valout, +! print *, "Got incorrect value for WIN_BASE (", valout, ! & ", should be ", baseadd, ")" ! endif endif diff --git a/teshsuite/smpi/mpich3-test/f90/rma/c2f2cwinf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/c2f2cwinf90.f90 index 62af7f5c11..df642c0831 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/c2f2cwinf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/c2f2cwinf90.f90 @@ -1,9 +1,9 @@ ! This file created from test/mpi/f77/rma/c2f2cwinf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. -! +! ! Test just MPI-RMA ! program main @@ -35,7 +35,7 @@ ! no info, in comm world, created with no memory (base address 0, ! displacement unit 1 call mpi_win_free( win, ierr ) - + ! ! Summarize the errors ! @@ -51,4 +51,4 @@ call mpi_finalize( ierr ) end - + diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winaccf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winaccf90.f90 index f9b8bb7190..c130eac09b 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winaccf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winaccf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winaccf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,16 +18,16 @@ ! Include addsize defines asize as an address-sized integer integer (kind=MPI_ADDRESS_KIND) asize - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize call mpi_win_create( buf, asize, intsize * nrows, & & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) left = rank - 1 @@ -39,7 +39,7 @@ right = MPI_PROC_NULL endif ! -! Initialize the buffer +! Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -50,7 +50,7 @@ enddo enddo call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr ) -! +! asize = ncols + 1 call mpi_accumulate( buf(1,1), nrows, MPI_INTEGER, & & left, asize, & @@ -58,7 +58,7 @@ asize = 0 call mpi_accumulate( buf(1,ncols), nrows, MPI_INTEGER, right, & & asize, nrows, MPI_INTEGER, MPI_SUM, win, ierr ) -! +! call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + & & MPI_MODE_NOSUCCEED, win, ierr ) ! diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winattr2f90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winattr2f90.f90 index a898f6cec3..2032bf887d 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winattr2f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winattr2f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winattr2f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,7 +18,7 @@ ! The only difference between the MPI-2 and MPI-1 attribute caching ! routines in Fortran is that the take an address-sized integer ! instead of a simple integer. These still are not pointers, -! so the values are still just integers. +! so the values are still just integers. ! errs = 0 call mtest_init( ierr ) @@ -27,7 +27,7 @@ val = 10 call mpi_win_create( buf, val, 1, & & MPI_INFO_NULL, comm, win, ierr ) -! +! extrastate = 1001 call mpi_win_create_keyval( MPI_WIN_DUP_FN, & & MPI_WIN_NULL_DELETE_FN, keyval, & @@ -49,7 +49,7 @@ print *, 'Unexpected value (should be 2003)', valout, & & ' from attr' endif - + valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) flag = .false. @@ -69,7 +69,7 @@ errs = errs + 1 print *, ' Delete_attr did not delete attribute' endif - + ! Test the delete function on window free valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winattrf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winattrf90.f90 index b8fef14e58..af5ab046c8 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winattrf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winattrf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winattrf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -19,7 +19,7 @@ ! The only difference between the MPI-2 and MPI-1 attribute caching ! routines in Fortran is that the take an address-sized integer ! instead of a simple integer. These still are not pointers, -! so the values are still just integers. +! so the values are still just integers. ! errs = 0 callcount = 0 @@ -30,7 +30,7 @@ val = 10 call mpi_win_create( buf, val, 1, & & MPI_INFO_NULL, comm, win, ierr ) -! +! extrastate = 1001 call mpi_win_create_keyval( mycopyfn, mydelfn, keyval, & & extrastate, ierr ) @@ -51,7 +51,7 @@ print *, 'Unexpected value (should be 2003)', valout, & & ' from attr' endif - + valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) flag = .false. @@ -76,7 +76,7 @@ errs = errs + 1 print *, ' Delete_attr did not delete attribute' endif - + ! Test the delete function on window free valin = 2001 call mpi_win_set_attr( win, keyval, valin, ierr ) @@ -105,14 +105,14 @@ valout = -1 ierr = -1 call MPI_WIN_DUP_FN( win, keyval, extrastate, valin, valout, & - & flag, ierr ) + & flag, ierr ) if (.not. flag) then errs = errs + 1 print *, " Flag was false after MPI_WIN_DUP_FN" else if (valout .ne. 7001) then errs = errs + 1 if (valout .eq. -1 ) then - print *, " output attr value was not copied in MPI_WIN_DUP_FN" + print *, " output attr value was not copied in MPI_WIN_DUP_FN" endif print *, " value was ", valout, " but expected 7001" else if (ierr .ne. MPI_SUCCESS) then @@ -125,14 +125,14 @@ valout = -1 ierr = -1 call MPI_WIN_NULL_COPY_FN( win, keyval, extrastate, valin, valout & - & ,flag, ierr ) + & ,flag, ierr ) if (flag) then errs = errs + 1 print *, " Flag was true after MPI_WIN_NULL_COPY_FN" else if (valout .ne. -1) then errs = errs + 1 print *, & - & " output attr value was copied in MPI_WIN_NULL_COPY_FN" + & " output attr value was copied in MPI_WIN_NULL_COPY_FN" else if (ierr .ne. MPI_SUCCESS) then errs = errs + 1 print *, " MPI_WIN_NULL_COPY_FN did not return MPI_SUCCESS" diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winerrf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winerrf90.f90 index d21060118b..a30e2df4ac 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winerrf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winerrf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winerrf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -12,7 +12,7 @@ integer buf(10) integer win ! external myerrhanfunc - INTERFACE + INTERFACE SUBROUTINE myerrhanfunc(vv0,vv1) INTEGER vv0,vv1 END SUBROUTINE @@ -61,7 +61,7 @@ call mpi_win_call_errhandler( win, newerrclass, ierr ) call mpi_win_call_errhandler( win, code(1), ierr ) call mpi_win_call_errhandler( win, code(2), ierr ) - + if (callcount .ne. 3) then errs = errs + 1 print *, ' Expected 3 calls to error handler, found ', & diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winfencef90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winfencef90.f90 index d124423940..f52cf22a55 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winfencef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winfencef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winfencef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,16 +18,16 @@ ! Include addsize defines asize as an address-sized integer integer (kind=MPI_ADDRESS_KIND) asize - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize call mpi_win_create( buf, asize, intsize * nrows, & & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) left = rank - 1 @@ -39,7 +39,7 @@ right = MPI_PROC_NULL endif ! -! Initialize the buffer +! Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -50,14 +50,14 @@ enddo enddo call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr ) -! +! asize = ncols+1 call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, & & nrows, MPI_INTEGER, win, ierr ) asize = 0 call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, & & nrows, MPI_INTEGER, win, ierr ) -! +! call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + & & MPI_MODE_NOSUCCEED, win, ierr ) ! diff --git a/teshsuite/smpi/mpich3-test/f90/rma/wingetf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/wingetf90.f90 index 648348ed3a..6e1e779fd0 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/wingetf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/wingetf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/wingetf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,16 +18,16 @@ ! Include addsize defines asize as an address-sized integer integer (kind=MPI_ADDRESS_KIND) asize - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize call mpi_win_create( buf, asize, intsize * nrows, & & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) left = rank - 1 @@ -39,7 +39,7 @@ right = MPI_PROC_NULL endif ! -! Initialize the buffer +! Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -50,14 +50,14 @@ enddo enddo call mpi_win_fence( MPI_MODE_NOPRECEDE, win, ierr ) -! +! asize = 1 call mpi_get( buf(1,ncols+1), nrows, MPI_INTEGER, right, & & asize, nrows, MPI_INTEGER, win, ierr ) asize = ncols call mpi_get( buf(1,0), nrows, MPI_INTEGER, left, & & asize, nrows, MPI_INTEGER, win, ierr ) -! +! call mpi_win_fence( MPI_MODE_NOSTORE + MPI_MODE_NOPUT + & & MPI_MODE_NOSUCCEED, win, ierr ) ! diff --git a/teshsuite/smpi/mpich3-test/f90/rma/wingroupf90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/wingroupf90.f90 index a936c8c38e..84243f10de 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/wingroupf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/wingroupf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/wingroupf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -17,11 +17,11 @@ call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = 10 call mpi_win_create( buf, asize, intsize, & & MPI_INFO_NULL, comm, win, ierr ) - + call mpi_comm_group( comm, group1, ierr ) call mpi_win_get_group( win, group2, ierr ) call mpi_group_compare( group1, group2, result, ierr ) diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winnamef90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winnamef90.f90 index 00f790b9ea..54955db599 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winnamef90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winnamef90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winnamef.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -20,7 +20,7 @@ call mtest_init( ierr ) ! ! Create a window and get, set the names on it -! +! call mpi_type_size( MPI_INTEGER, intsize, ierr ) asize = 10 call mpi_win_create( buf, asize, intsize, & @@ -72,7 +72,7 @@ print *, ' window name is not blank padded' endif endif -! +! call mpi_win_free( win, ierr ) call mtest_finalize( errs ) call mpi_finalize( ierr ) diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winscale1f90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winscale1f90.f90 index fcf0e021c9..9a3663269d 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winscale1f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winscale1f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winscale1f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -18,16 +18,16 @@ ! Include addsize defines asize as an address-sized integer integer (kind=MPI_ADDRESS_KIND) asize - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize call mpi_win_create( buf, asize, intsize * nrows, & & MPI_INFO_NULL, comm, win, ierr ) - + ! Create the group for the neighbors call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) @@ -50,7 +50,7 @@ call mpi_group_incl( group, nneighbors, nbrs, group2, ierr ) call mpi_group_free( group, ierr ) ! -! Initialize the buffer +! Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -62,14 +62,14 @@ enddo call mpi_win_post( group2, 0, win, ierr ) call mpi_win_start( group2, 0, win, ierr ) -! +! asize = ncols+1 call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, & & nrows, MPI_INTEGER, win, ierr ) asize = 0 call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, & & nrows, MPI_INTEGER, win, ierr ) -! +! call mpi_win_complete( win, ierr ) call mpi_win_wait( win, ierr ) ! diff --git a/teshsuite/smpi/mpich3-test/f90/rma/winscale2f90.f90 b/teshsuite/smpi/mpich3-test/f90/rma/winscale2f90.f90 index b9c7812082..4566678d02 100644 --- a/teshsuite/smpi/mpich3-test/f90/rma/winscale2f90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/rma/winscale2f90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/rma/winscale2f.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -19,16 +19,16 @@ ! Include addsize defines asize as an address-sized integer integer (kind=MPI_ADDRESS_KIND) asize - + errs = 0 call mtest_init( ierr ) call mpi_type_size( MPI_INTEGER, intsize, ierr ) - do while( mtestGetIntraComm( comm, 2, .false. ) ) + do while( mtestGetIntraComm( comm, 2, .false. ) ) asize = nrows * (ncols + 2) * intsize call mpi_win_create( buf, asize, intsize * nrows, & & MPI_INFO_NULL, comm, win, ierr ) - + ! Create the group for the neighbors call mpi_comm_size( comm, size, ierr ) call mpi_comm_rank( comm, rank, ierr ) @@ -51,7 +51,7 @@ call mpi_group_incl( group, nneighbors, nbrs, group2, ierr ) call mpi_group_free( group, ierr ) ! -! Initialize the buffer +! Initialize the buffer do i=1,nrows buf(i,0) = -1 buf(i,ncols+1) = -1 @@ -63,14 +63,14 @@ enddo call mpi_win_post( group2, 0, win, ierr ) call mpi_win_start( group2, 0, win, ierr ) -! +! asize = ncols+1 call mpi_put( buf(1,1), nrows, MPI_INTEGER, left, asize, & & nrows, MPI_INTEGER, win, ierr ) asize = 0 call mpi_put( buf(1,ncols), nrows, MPI_INTEGER, right, asize, & & nrows, MPI_INTEGER, win, ierr ) -! +! call mpi_win_complete( win, ierr ) flag = .false. do while (.not. flag) diff --git a/teshsuite/smpi/mpich3-test/f90/util/mtestf90.f90 b/teshsuite/smpi/mpich3-test/f90/util/mtestf90.f90 index bb12b29e24..8b27f4cf6b 100644 --- a/teshsuite/smpi/mpich3-test/f90/util/mtestf90.f90 +++ b/teshsuite/smpi/mpich3-test/f90/util/mtestf90.f90 @@ -1,5 +1,5 @@ ! This file created from test/mpi/f77/util/mtestf.f with f77tof90 -! -*- Mode: Fortran; -*- +! -*- Mode: Fortran; -*- ! ! (C) 2003 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. @@ -29,14 +29,14 @@ use mpi integer errs integer rank, toterrs, ierr - + call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr ) call MPI_Allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM, & - & MPI_COMM_WORLD, ierr ) - + & MPI_COMM_WORLD, ierr ) + if (rank .eq. 0) then - if (toterrs .gt. 0) then + if (toterrs .gt. 0) then print *, " Found ", toterrs, " errors" else print *, " No Errors" @@ -107,5 +107,5 @@ call MPI_Error_class( errcode, errclass, ierr ) call MPI_Error_string( errcode, string, slen, ierr ) print *, msg, ": Error class ", errclass, " & - & (", string(1:slen), ")" + & (", string(1:slen), ")" end diff --git a/teshsuite/smpi/mpich3-test/perf/README b/teshsuite/smpi/mpich3-test/perf/README index cf5d5d2cb0..423fff5e64 100644 --- a/teshsuite/smpi/mpich3-test/perf/README +++ b/teshsuite/smpi/mpich3-test/perf/README @@ -1,8 +1,7 @@ -This directory contains some performance tests. These are not +This directory contains some performance tests. These are not general performance tests; rather, they reflect our experience with particular performance articfacts that users (or ourselves) haver reported or experienced. The tests include: sendrecvl - Send and receive (head to head) large messages. mattrans - Matrix transpose example - diff --git a/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c b/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c index 0af8ea49ec..99b3ba8520 100644 --- a/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c +++ b/teshsuite/smpi/mpich3-test/pt2pt/rqfreeb.c @@ -7,7 +7,7 @@ #include #include #include "mpitest.h" -#define USE_STRICT_MPI 1 +#define USE_STRICT_MPI 1 /* Test Ibsend and Request_free */ int main(int argc, char *argv[]) { -- 2.20.1