From c97864e17c8e894185ca9b9f9e82d4f93b786d1f Mon Sep 17 00:00:00 2001 From: edoapra Date: Mon, 3 Nov 2025 14:28:00 -0800 Subject: [PATCH] grab MPI_Comm_Rank and MPI_Comm_Size before GA is initialized addresses https://github.com/nwchemgit/nwchem/issues/1196 --- src/nwchem.F | 3 ++- src/peigs_comm/mxsubs.F | 10 +++++++--- src/util/GNUmakefile | 2 ++ src/util/util_mpic2f.F | 42 +++++++++++++++++++++++++++++++++++++++++ src/util/utilc_mpic2f.c | 23 ++++++++++++++++++++++ 5 files changed, 76 insertions(+), 4 deletions(-) create mode 100644 src/util/util_mpic2f.F create mode 100644 src/util/utilc_mpic2f.c diff --git a/src/nwchem.F b/src/nwchem.F index 6b9f051928..7808b52a28 100644 --- a/src/nwchem.F +++ b/src/nwchem.F @@ -94,7 +94,8 @@ c Create parallel processes and initialize IPC layer c call pbeginf() -#ifdef PEIGS +C #ifdef PEIGS +#if 1 c c MXINIT is needed by PeIGS and PFFT to initialize c the communication fabric they use. diff --git a/src/peigs_comm/mxsubs.F b/src/peigs_comm/mxsubs.F index 7e8aa1aa19..f8f54e2d37 100644 --- a/src/peigs_comm/mxsubs.F +++ b/src/peigs_comm/mxsubs.F @@ -193,7 +193,9 @@ c external mynodes, numnodes #endif #ifdef TCGMSG - external nodeid, nnodes + integer util_mpicommsize,util_mpicommrank + external util_mpicommsize,util_mpicommrank +cold external nodeid, nnodes #endif #ifdef UNIPROC ienv(1) = 0 @@ -218,8 +220,10 @@ c ENDIF #endif #ifdef TCGMSG - ienv(1) = nodeid() - ienv(2) = nnodes() +cold ienv(1) = nodeid() +cold ienv(2) = nnodes() + ienv(1)=util_mpicommrank() + ienv(2)=util_mpicommsize() #endif #ifdef iPSC_NATIVE ienv(1) = mynode () diff --git a/src/util/GNUmakefile b/src/util/GNUmakefile index 35c19471c6..e5ea3fed11 100644 --- a/src/util/GNUmakefile +++ b/src/util/GNUmakefile @@ -194,6 +194,8 @@ endif banner.o util_print.o util_module_avail.o \ util_version.o util_nwchem_version.o util_ga_version.o \ util_nwchem_paper.o util_nwchem_srcdir.o utilc_nwchem_srcdir.o \ + utilc_mpic2f.o \ + util_mpic2f.o \ mk_fit_xf.o \ int_2c_ga.o \ ma_solve.o \ diff --git a/src/util/util_mpic2f.F b/src/util/util_mpic2f.F new file mode 100644 index 0000000000..d612fabb3d --- /dev/null +++ b/src/util/util_mpic2f.F @@ -0,0 +1,42 @@ +C> \brief The Fortran interface routine to get the NWCHEM source +C> directory +C> +C> In order to compile the source code location into the code we have +C> to choose between two evils: +C> - Either we struggle with the random Fortran line length limits +C> (because they were such a disaster in Fortran77 compiler developers +C> have kindly carried these over into Fortran90 and further :-(. +C> - Or we have to generate the code is C and use to ISO_C_BINDING +C> module to integrate this into Fortran. +C> Either approach is a bit of a mess, so we encapsulate all the messing +C> around in this routine. This routine then provides a straightforward +C> interface that can simply be called from the Fortran code without +C> having to pull any stunts. +C> + integer function util_mpicommrank() + USE ISO_C_BINDING + implicit none + interface + subroutine utilc_mpicommrank(rank) bind(C) + use, intrinsic :: ISO_C_BINDING + integer (C_INT) :: rank + end subroutine + end interface + integer (C_INT) :: rank + call utilc_mpicommrank(rank) + util_mpicommrank=rank + end + integer function util_mpicommsize() + USE ISO_C_BINDING + implicit none + interface + subroutine utilc_mpicommsize(size) bind(C) + use, intrinsic :: ISO_C_BINDING + integer (C_INT) :: size + end subroutine + end interface + integer (C_INT) :: size + call utilc_mpicommsize(size) + util_mpicommsize=size + end +c $Id$ diff --git a/src/util/utilc_mpic2f.c b/src/util/utilc_mpic2f.c new file mode 100644 index 0000000000..86815b6cb6 --- /dev/null +++ b/src/util/utilc_mpic2f.c @@ -0,0 +1,23 @@ +#include +#ifdef XLFLINUX +void utilc_mpicommrank_( +#else +void utilc_mpicommrank( +#endif + int *me) +{ + int myid; + MPI_Comm_rank(MPI_COMM_WORLD,&myid); + *me= myid; +} +#ifdef XLFLINUX +void utilc_mpicommsize_( +#else +void utilc_mpicommsize( +#endif + int *size) +{ + int mysize; + MPI_Comm_size(MPI_COMM_WORLD,&mysize); + *size= mysize; +}