src/gmxlib/network.c

   1 /*
   2  * This file is part of the GROMACS molecular simulation package.
   3  *
   4  * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
   5  * Copyright (c) 2001-2004, The GROMACS development team,
   6  * check out http://www.gromacs.org for more information.
   7  * Copyright (c) 2012,2013, by the GROMACS development team, led by
   8  * David van der Spoel, Berk Hess, Erik Lindahl, and including many
   9  * others, as listed in the AUTHORS file in the top-level source
  10  * directory and at http://www.gromacs.org.
  11  *
  12  * GROMACS is free software; you can redistribute it and/or
  13  * modify it under the terms of the GNU Lesser General Public License
  14  * as published by the Free Software Foundation; either version 2.1
  15  * of the License, or (at your option) any later version.
  16  *
  17  * GROMACS is distributed in the hope that it will be useful,
  18  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  19  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20  * Lesser General Public License for more details.
  21  *
  22  * You should have received a copy of the GNU Lesser General Public
  23  * License along with GROMACS; if not, see
  24  * http://www.gnu.org/licenses, or write to the Free Software Foundation,
  25  * Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA.
  26  *
  27  * If you want to redistribute modifications to GROMACS, please
  28  * consider that scientific software is very special. Version
  29  * control is crucial - bugs must be traceable. We will be happy to
  30  * consider code for inclusion in the official distribution, but
  31  * derived work must not be called official GROMACS. Details are found
  32  * in the README & COPYING files - if they are missing, get the
  33  * official version at http://www.gromacs.org.
  34  *
  35  * To help us fund GROMACS development, we humbly ask that you cite
  36  * the research papers on the package. Check out http://www.gromacs.org.
  37  */
  38 #ifdef HAVE_CONFIG_H
  39 #include <config.h>
  40 #endif
  41
  42 #include <string.h>
  43 #include "gmx_fatal.h"
  44 #include "main.h"
  45 #include "smalloc.h"
  46 #include "network.h"
  47 #include "copyrite.h"
  48 #include "statutil.h"
  49 #include <ctype.h>
  50 #include "macros.h"
  51
  52 #ifdef GMX_LIB_MPI
  53 #include <mpi.h>
  54 #endif
  55
  56 #ifdef GMX_THREAD_MPI
  57 #include "tmpi.h"
  58 #endif
  59
  60 #include "mpelogging.h"
  61
  62 /* The source code in this file should be thread-safe.
  63       Please keep it that way. */
  64
  65 gmx_bool gmx_mpi_initialized(void)
  66 {
  67     int n;
  68 #ifndef GMX_MPI
  69     return 0;
  70 #else
  71     MPI_Initialized(&n);
  72
  73     return n;
  74 #endif
  75 }
  76
  77 int gmx_setup(int *argc, char **argv, int *nnodes)
  78 {
  79 #ifndef GMX_MPI
  80     gmx_call("gmx_setup");
  81     return 0;
  82 #else
  83     char   buf[256];
  84     int    resultlen;             /* actual length of node name      */
  85     int    i, flag;
  86     int    mpi_num_nodes;
  87     int    mpi_my_rank;
  88     char   mpi_hostname[MPI_MAX_PROCESSOR_NAME];
  89
  90     /* Call the MPI routines */
  91 #ifdef GMX_LIB_MPI
  92 #ifdef GMX_FAHCORE
  93     (void) fah_MPI_Init(argc, &argv);
  94 #else
  95     (void) MPI_Init(argc, &argv);
  96 #endif
  97 #endif
  98     (void) MPI_Comm_size( MPI_COMM_WORLD, &mpi_num_nodes );
  99     (void) MPI_Comm_rank( MPI_COMM_WORLD, &mpi_my_rank );
 100     (void) MPI_Get_processor_name( mpi_hostname, &resultlen );
 101
 102
 103 #ifdef USE_MPE
 104     /* MPE logging routines. Get event IDs from MPE: */
 105     /* General events */
 106     ev_timestep1               = MPE_Log_get_event_number( );
 107     ev_timestep2               = MPE_Log_get_event_number( );
 108     ev_force_start             = MPE_Log_get_event_number( );
 109     ev_force_finish            = MPE_Log_get_event_number( );
 110     ev_do_fnbf_start           = MPE_Log_get_event_number( );
 111     ev_do_fnbf_finish          = MPE_Log_get_event_number( );
 112     ev_ns_start                = MPE_Log_get_event_number( );
 113     ev_ns_finish               = MPE_Log_get_event_number( );
 114     ev_calc_bonds_start        = MPE_Log_get_event_number( );
 115     ev_calc_bonds_finish       = MPE_Log_get_event_number( );
 116     ev_global_stat_start       = MPE_Log_get_event_number( );
 117     ev_global_stat_finish      = MPE_Log_get_event_number( );
 118     ev_virial_start            = MPE_Log_get_event_number( );
 119     ev_virial_finish           = MPE_Log_get_event_number( );
 120
 121     /* Shift related events */
 122     ev_shift_start             = MPE_Log_get_event_number( );
 123     ev_shift_finish            = MPE_Log_get_event_number( );
 124     ev_unshift_start           = MPE_Log_get_event_number( );
 125     ev_unshift_finish          = MPE_Log_get_event_number( );
 126     ev_mk_mshift_start         = MPE_Log_get_event_number( );
 127     ev_mk_mshift_finish        = MPE_Log_get_event_number( );
 128
 129     /* PME related events */
 130     ev_pme_start                = MPE_Log_get_event_number( );
 131     ev_pme_finish               = MPE_Log_get_event_number( );
 132     ev_spread_on_grid_start     = MPE_Log_get_event_number( );
 133     ev_spread_on_grid_finish    = MPE_Log_get_event_number( );
 134     ev_sum_qgrid_start          = MPE_Log_get_event_number( );
 135     ev_sum_qgrid_finish         = MPE_Log_get_event_number( );
 136     ev_gmxfft3d_start           = MPE_Log_get_event_number( );
 137     ev_gmxfft3d_finish          = MPE_Log_get_event_number( );
 138     ev_solve_pme_start          = MPE_Log_get_event_number( );
 139     ev_solve_pme_finish         = MPE_Log_get_event_number( );
 140     ev_gather_f_bsplines_start  = MPE_Log_get_event_number( );
 141     ev_gather_f_bsplines_finish = MPE_Log_get_event_number( );
 142     ev_reduce_start             = MPE_Log_get_event_number( );
 143     ev_reduce_finish            = MPE_Log_get_event_number( );
 144     ev_rscatter_start           = MPE_Log_get_event_number( );
 145     ev_rscatter_finish          = MPE_Log_get_event_number( );
 146     ev_alltoall_start           = MPE_Log_get_event_number( );
 147     ev_alltoall_finish          = MPE_Log_get_event_number( );
 148     ev_pmeredist_start          = MPE_Log_get_event_number( );
 149     ev_pmeredist_finish         = MPE_Log_get_event_number( );
 150     ev_init_pme_start           = MPE_Log_get_event_number( );
 151     ev_init_pme_finish          = MPE_Log_get_event_number( );
 152     ev_send_coordinates_start   = MPE_Log_get_event_number( );
 153     ev_send_coordinates_finish  = MPE_Log_get_event_number( );
 154     ev_update_fr_start          = MPE_Log_get_event_number( );
 155     ev_update_fr_finish         = MPE_Log_get_event_number( );
 156     ev_clear_rvecs_start        = MPE_Log_get_event_number( );
 157     ev_clear_rvecs_finish       = MPE_Log_get_event_number( );
 158     ev_update_start             = MPE_Log_get_event_number( );
 159     ev_update_finish            = MPE_Log_get_event_number( );
 160     ev_output_start             = MPE_Log_get_event_number( );
 161     ev_output_finish            = MPE_Log_get_event_number( );
 162     ev_sum_lrforces_start       = MPE_Log_get_event_number( );
 163     ev_sum_lrforces_finish      = MPE_Log_get_event_number( );
 164     ev_sort_start               = MPE_Log_get_event_number( );
 165     ev_sort_finish              = MPE_Log_get_event_number( );
 166     ev_sum_qgrid_start          = MPE_Log_get_event_number( );
 167     ev_sum_qgrid_finish         = MPE_Log_get_event_number( );
 168
 169     /* Essential dynamics related events */
 170     ev_edsam_start             = MPE_Log_get_event_number( );
 171     ev_edsam_finish            = MPE_Log_get_event_number( );
 172     ev_get_coords_start        = MPE_Log_get_event_number( );
 173     ev_get_coords_finish       = MPE_Log_get_event_number( );
 174     ev_ed_apply_cons_start     = MPE_Log_get_event_number( );
 175     ev_ed_apply_cons_finish    = MPE_Log_get_event_number( );
 176     ev_fit_to_reference_start  = MPE_Log_get_event_number( );
 177     ev_fit_to_reference_finish = MPE_Log_get_event_number( );
 178
 179     /* describe events: */
 180     if (mpi_my_rank == 0)
 181     {
 182         /* General events */
 183         MPE_Describe_state(ev_timestep1,               ev_timestep2,                "timestep START",  "magenta" );
 184         MPE_Describe_state(ev_force_start,             ev_force_finish,             "force",           "cornflower blue" );
 185         MPE_Describe_state(ev_do_fnbf_start,           ev_do_fnbf_finish,           "do_fnbf",         "navy" );
 186         MPE_Describe_state(ev_ns_start,                ev_ns_finish,                "neighbor search", "tomato" );
 187         MPE_Describe_state(ev_calc_bonds_start,        ev_calc_bonds_finish,        "bonded forces",   "slate blue" );
 188         MPE_Describe_state(ev_global_stat_start,       ev_global_stat_finish,       "global stat",     "firebrick3");
 189         MPE_Describe_state(ev_update_fr_start,         ev_update_fr_finish,         "update forcerec", "goldenrod");
 190         MPE_Describe_state(ev_clear_rvecs_start,       ev_clear_rvecs_finish,       "clear rvecs",     "bisque");
 191         MPE_Describe_state(ev_update_start,            ev_update_finish,            "update",          "cornsilk");
 192         MPE_Describe_state(ev_output_start,            ev_output_finish,            "output",          "black");
 193         MPE_Describe_state(ev_virial_start,            ev_virial_finish,            "calc_virial",     "thistle4");
 194
 195         /* PME related events */
 196         MPE_Describe_state(ev_pme_start,               ev_pme_finish,               "doing PME",       "grey" );
 197         MPE_Describe_state(ev_spread_on_grid_start,    ev_spread_on_grid_finish,    "spread",          "dark orange" );
 198         MPE_Describe_state(ev_sum_qgrid_start,         ev_sum_qgrid_finish,         "sum qgrid",       "slate blue");
 199         MPE_Describe_state(ev_gmxfft3d_start,          ev_gmxfft3d_finish,          "fft3d",           "snow2" );
 200         MPE_Describe_state(ev_solve_pme_start,         ev_solve_pme_finish,         "solve PME",       "indian red" );
 201         MPE_Describe_state(ev_gather_f_bsplines_start, ev_gather_f_bsplines_finish, "bsplines",        "light sea green" );
 202         MPE_Describe_state(ev_reduce_start,            ev_reduce_finish,            "reduce",          "cyan1" );
 203         MPE_Describe_state(ev_rscatter_start,          ev_rscatter_finish,          "rscatter",        "cyan3" );
 204         MPE_Describe_state(ev_alltoall_start,          ev_alltoall_finish,          "alltoall",        "LightCyan4" );
 205         MPE_Describe_state(ev_pmeredist_start,         ev_pmeredist_finish,         "pmeredist",       "thistle" );
 206         MPE_Describe_state(ev_init_pme_start,          ev_init_pme_finish,          "init PME",        "snow4");
 207         MPE_Describe_state(ev_send_coordinates_start,  ev_send_coordinates_finish,  "send_coordinates", "blue");
 208         MPE_Describe_state(ev_sum_lrforces_start,      ev_sum_lrforces_finish,      "sum_LRforces",    "lime green");
 209         MPE_Describe_state(ev_sort_start,              ev_sort_finish,              "sort pme atoms",  "brown");
 210         MPE_Describe_state(ev_sum_qgrid_start,         ev_sum_qgrid_finish,         "sum charge grid", "medium orchid");
 211
 212         /* Shift related events */
 213         MPE_Describe_state(ev_shift_start,             ev_shift_finish,             "shift",           "orange");
 214         MPE_Describe_state(ev_unshift_start,           ev_unshift_finish,           "unshift",         "dark orange");
 215         MPE_Describe_state(ev_mk_mshift_start,         ev_mk_mshift_finish,         "mk_mshift",       "maroon");
 216
 217         /* Essential dynamics related events */
 218         MPE_Describe_state(ev_edsam_start,             ev_edsam_finish,             "EDSAM",           "deep sky blue");
 219         MPE_Describe_state(ev_get_coords_start,        ev_get_coords_finish,        "ED get coords",   "steel blue");
 220         MPE_Describe_state(ev_ed_apply_cons_start,     ev_ed_apply_cons_finish,     "ED apply constr", "forest green");
 221         MPE_Describe_state(ev_fit_to_reference_start,  ev_fit_to_reference_finish,  "ED fit to ref",   "lavender");
 222
 223     }
 224     MPE_Init_log();
 225 #endif
 226
 227 #ifdef GMX_LIB_MPI
 228     if (debug)
 229     {
 230         fprintf(debug, "NNODES=%d, MYRANK=%d, HOSTNAME=%s\n",
 231                 mpi_num_nodes, mpi_my_rank, mpi_hostname);
 232     }
 233 #endif
 234
 235     *nnodes = mpi_num_nodes;
 236
 237     return mpi_my_rank;
 238 #endif
 239 }
 240
 241 int  gmx_node_num(void)
 242 {
 243 #ifndef GMX_MPI
 244     return 1;
 245 #else
 246     int i;
 247     (void) MPI_Comm_size(MPI_COMM_WORLD, &i);
 248     return i;
 249 #endif
 250 }
 251
 252 int gmx_node_rank(void)
 253 {
 254 #ifndef GMX_MPI
 255     return 0;
 256 #else
 257     int i;
 258     (void) MPI_Comm_rank(MPI_COMM_WORLD, &i);
 259     return i;
 260 #endif
 261 }
 262
 263 #if defined GMX_LIB_MPI && defined GMX_IS_BGQ
 264 #include <spi/include/kernel/location.h>
 265 #endif
 266
 267 int gmx_hostname_num()
 268 {
 269 #ifndef GMX_MPI
 270     return 0;
 271 #else
 272 #ifdef GMX_THREAD_MPI
 273     /* thread-MPI currently puts the thread number in the process name,
 274      * we might want to change this, as this is inconsistent with what
 275      * most MPI implementations would do when running on a single node.
 276      */
 277     return 0;
 278 #else
 279     int  resultlen, hostnum, i, j;
 280     char mpi_hostname[MPI_MAX_PROCESSOR_NAME], hostnum_str[MPI_MAX_PROCESSOR_NAME];
 281
 282     MPI_Get_processor_name(mpi_hostname, &resultlen);
 283 #ifdef GMX_IS_BGQ
 284     Personality_t personality;
 285     Kernel_GetPersonality(&personality, sizeof(personality));
 286     /* Each MPI rank has a unique coordinate in a 6-dimensional space
 287        (A,B,C,D,E,T), with dimensions A-E corresponding to different
 288        physical nodes, and T within each node. Each node has sixteen
 289        physical cores, each of which can have up to four hardware
 290        threads, so 0 <= T <= 63 (but the maximum value of T depends on
 291        the confituration of ranks and OpenMP threads per
 292        node). However, T is irrelevant for computing a suitable return
 293        value for gmx_hostname_num().
 294      */
 295     hostnum  = personality.Network_Config.Acoord;
 296     hostnum *= personality.Network_Config.Bnodes;
 297     hostnum += personality.Network_Config.Bcoord;
 298     hostnum *= personality.Network_Config.Cnodes;
 299     hostnum += personality.Network_Config.Ccoord;
 300     hostnum *= personality.Network_Config.Dnodes;
 301     hostnum += personality.Network_Config.Dcoord;
 302     hostnum *= personality.Network_Config.Enodes;
 303     hostnum += personality.Network_Config.Ecoord;
 304 #else
 305     /* This procedure can only differentiate nodes with host names
 306      * that end on unique numbers.
 307      */
 308     i = 0;
 309     j = 0;
 310     /* Only parse the host name up to the first dot */
 311     while (i < resultlen && mpi_hostname[i] != '.')
 312     {
 313         if (isdigit(mpi_hostname[i]))
 314         {
 315             hostnum_str[j++] = mpi_hostname[i];
 316         }
 317         i++;
 318     }
 319     hostnum_str[j] = '\0';
 320     if (j == 0)
 321     {
 322         hostnum = 0;
 323     }
 324     else
 325     {
 326         /* Use only the last 9 decimals, so we don't overflow an int */
 327         hostnum = strtol(hostnum_str + max(0, j-9), NULL, 10);
 328     }
 329 #endif
 330
 331     if (debug)
 332     {
 333         fprintf(debug, "In gmx_hostname_num: hostname '%s', hostnum %d\n",
 334                 mpi_hostname, hostnum);
 335 #ifdef GMX_IS_BGQ
 336         fprintf(debug,
 337                 "Torus ID A: %d / %d B: %d / %d C: %d / %d D: %d / %d E: %d / %d\nNode ID T: %d / %d core: %d / %d hardware thread: %d / %d\n",
 338                 personality.Network_Config.Acoord,
 339                 personality.Network_Config.Anodes,
 340                 personality.Network_Config.Bcoord,
 341                 personality.Network_Config.Bnodes,
 342                 personality.Network_Config.Ccoord,
 343                 personality.Network_Config.Cnodes,
 344                 personality.Network_Config.Dcoord,
 345                 personality.Network_Config.Dnodes,
 346                 personality.Network_Config.Ecoord,
 347                 personality.Network_Config.Enodes,
 348                 Kernel_ProcessorCoreID(),
 349                 16,
 350                 Kernel_ProcessorID(),
 351                 64,
 352                 Kernel_ProcessorThreadID(),
 353                 4);
 354 #endif
 355     }
 356     return hostnum;
 357 #endif
 358 #endif
 359 }
 360
 361 void gmx_setup_nodecomm(FILE *fplog, t_commrec *cr)
 362 {
 363     gmx_nodecomm_t *nc;
 364     int             n, rank, hostnum, ng, ni;
 365
 366     /* Many MPI implementations do not optimize MPI_Allreduce
 367      * (and probably also other global communication calls)
 368      * for multi-core nodes connected by a network.
 369      * We can optimize such communication by using one MPI call
 370      * within each node and one between the nodes.
 371      * For MVAPICH2 and Intel MPI this reduces the time for
 372      * the global_stat communication by 25%
 373      * for 2x2-core 3 GHz Woodcrest connected by mixed DDR/SDR Infiniband.
 374      * B. Hess, November 2007
 375      */
 376
 377     nc = &cr->nc;
 378
 379     nc->bUse = FALSE;
 380 #ifndef GMX_THREAD_MPI
 381 #ifdef GMX_MPI
 382     MPI_Comm_size(cr->mpi_comm_mygroup, &n);
 383     MPI_Comm_rank(cr->mpi_comm_mygroup, &rank);
 384
 385     hostnum = gmx_hostname_num();
 386
 387     if (debug)
 388     {
 389         fprintf(debug, "In gmx_setup_nodecomm: splitting communicator of size %d\n", n);
 390     }
 391
 392
 393     /* The intra-node communicator, split on node number */
 394     MPI_Comm_split(cr->mpi_comm_mygroup, hostnum, rank, &nc->comm_intra);
 395     MPI_Comm_rank(nc->comm_intra, &nc->rank_intra);
 396     if (debug)
 397     {
 398         fprintf(debug, "In gmx_setup_nodecomm: node rank %d rank_intra %d\n",
 399                 rank, nc->rank_intra);
 400     }
 401     /* The inter-node communicator, split on rank_intra.
 402      * We actually only need the one for rank=0,
 403      * but it is easier to create them all.
 404      */
 405     MPI_Comm_split(cr->mpi_comm_mygroup, nc->rank_intra, rank, &nc->comm_inter);
 406     /* Check if this really created two step communication */
 407     MPI_Comm_size(nc->comm_inter, &ng);
 408     MPI_Comm_size(nc->comm_intra, &ni);
 409     if (debug)
 410     {
 411         fprintf(debug, "In gmx_setup_nodecomm: groups %d, my group size %d\n",
 412                 ng, ni);
 413     }
 414
 415     if (getenv("GMX_NO_NODECOMM") == NULL &&
 416         ((ng > 1 && ng < n) || (ni > 1 && ni < n)))
 417     {
 418         nc->bUse = TRUE;
 419         if (fplog)
 420         {
 421             fprintf(fplog, "Using two step summing over %d groups of on average %.1f processes\n\n",
 422                     ng, (real)n/(real)ng);
 423         }
 424         if (nc->rank_intra > 0)
 425         {
 426             MPI_Comm_free(&nc->comm_inter);
 427         }
 428     }
 429     else
 430     {
 431         /* One group or all processes in a separate group, use normal summing */
 432         MPI_Comm_free(&nc->comm_inter);
 433         MPI_Comm_free(&nc->comm_intra);
 434         if (debug)
 435         {
 436             fprintf(debug, "In gmx_setup_nodecomm: not unsing separate inter- and intra-node communicators.\n");
 437         }
 438     }
 439 #endif
 440 #else
 441     /* tMPI runs only on a single node so just use the nodeid */
 442     nc->rank_intra = cr->nodeid;
 443 #endif
 444 }
 445
 446 void gmx_init_intranode_counters(t_commrec *cr)
 447 {
 448     /* counters for PP+PME and PP-only processes on my physical node */
 449     int nrank_intranode, rank_intranode;
 450     int nrank_pp_intranode, rank_pp_intranode;
 451     /* thread-MPI is not initialized when not running in parallel */
 452 #if defined GMX_MPI && !defined GMX_THREAD_MPI
 453     int nrank_world, rank_world;
 454     int i, mynum, *num, *num_s, *num_pp, *num_pp_s;
 455
 456     MPI_Comm_size(MPI_COMM_WORLD, &nrank_world);
 457     MPI_Comm_rank(MPI_COMM_WORLD, &rank_world);
 458
 459     /* Get the node number from the hostname to identify the nodes */
 460     mynum = gmx_hostname_num();
 461
 462     /* We can't rely on MPI_IN_PLACE, so we need send and receive buffers */
 463     snew(num,   nrank_world);
 464     snew(num_s, nrank_world);
 465     snew(num_pp,   nrank_world);
 466     snew(num_pp_s, nrank_world);
 467
 468     num_s[rank_world]    = mynum;
 469     num_pp_s[rank_world] = (cr->duty & DUTY_PP) ? mynum : -1;
 470
 471     MPI_Allreduce(num_s,    num,    nrank_world, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
 472     MPI_Allreduce(num_pp_s, num_pp, nrank_world, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
 473
 474     nrank_intranode    = 0;
 475     rank_intranode     = 0;
 476     nrank_pp_intranode = 0;
 477     rank_pp_intranode  = 0;
 478     for (i = 0; i < nrank_world; i++)
 479     {
 480         if (num[i] == mynum)
 481         {
 482             nrank_intranode++;
 483             if (i < rank_world)
 484             {
 485                 rank_intranode++;
 486             }
 487         }
 488         if ((cr->duty & DUTY_PP) && num_pp[i] == mynum)
 489         {
 490             nrank_pp_intranode++;
 491             if (i < rank_world)
 492             {
 493                 rank_pp_intranode++;
 494             }
 495         }
 496     }
 497     sfree(num);
 498     sfree(num_s);
 499     sfree(num_pp);
 500     sfree(num_pp_s);
 501 #else
 502     /* Serial or thread-MPI code: we run within a single physical node */
 503     nrank_intranode    = cr->nnodes;
 504     rank_intranode     = cr->sim_nodeid;
 505     nrank_pp_intranode = cr->nnodes - cr->npmenodes;
 506     rank_pp_intranode  = cr->nodeid;
 507 #endif
 508
 509     if (debug)
 510     {
 511         char sbuf[STRLEN];
 512         if (cr->duty & DUTY_PP && cr->duty & DUTY_PME)
 513         {
 514             sprintf(sbuf, "PP+PME");
 515         }
 516         else
 517         {
 518             sprintf(sbuf, "%s", cr->duty & DUTY_PP ? "PP" : "PME");
 519         }
 520         fprintf(debug, "On %3s node %d: nrank_intranode=%d, rank_intranode=%d, "
 521                 "nrank_pp_intranode=%d, rank_pp_intranode=%d\n",
 522                 sbuf, cr->sim_nodeid,
 523                 nrank_intranode, rank_intranode,
 524                 nrank_pp_intranode, rank_pp_intranode);
 525     }
 526
 527     cr->nrank_intranode    = nrank_intranode;
 528     cr->rank_intranode     = rank_intranode;
 529     cr->nrank_pp_intranode = nrank_pp_intranode;
 530     cr->rank_pp_intranode  = rank_pp_intranode;
 531 }
 532
 533
 534 void gmx_barrier(const t_commrec *cr)
 535 {
 536 #ifndef GMX_MPI
 537     gmx_call("gmx_barrier");
 538 #else
 539     MPI_Barrier(cr->mpi_comm_mygroup);
 540 #endif
 541 }
 542
 543 void gmx_abort(int noderank, int nnodes, int errorno)
 544 {
 545 #ifndef GMX_MPI
 546     gmx_call("gmx_abort");
 547 #else
 548 #ifdef GMX_THREAD_MPI
 549     fprintf(stderr, "Halting program %s\n", ShortProgram());
 550     thanx(stderr);
 551     exit(1);
 552 #else
 553     if (nnodes > 1)
 554     {
 555         fprintf(stderr, "Halting parallel program %s on CPU %d out of %d\n",
 556                 ShortProgram(), noderank, nnodes);
 557     }
 558     else
 559     {
 560         fprintf(stderr, "Halting program %s\n", ShortProgram());
 561     }
 562
 563     thanx(stderr);
 564     MPI_Abort(MPI_COMM_WORLD, errorno);
 565     exit(1);
 566 #endif
 567 #endif
 568 }
 569
 570 void gmx_bcast(int nbytes, void *b, const t_commrec *cr)
 571 {
 572 #ifndef GMX_MPI
 573     gmx_call("gmx_bast");
 574 #else
 575     MPI_Bcast(b, nbytes, MPI_BYTE, MASTERRANK(cr), cr->mpi_comm_mygroup);
 576 #endif
 577 }
 578
 579 void gmx_bcast_sim(int nbytes, void *b, const t_commrec *cr)
 580 {
 581 #ifndef GMX_MPI
 582     gmx_call("gmx_bast");
 583 #else
 584     MPI_Bcast(b, nbytes, MPI_BYTE, MASTERRANK(cr), cr->mpi_comm_mysim);
 585 #endif
 586 }
 587
 588 void gmx_sumd(int nr, double r[], const t_commrec *cr)
 589 {
 590 #ifndef GMX_MPI
 591     gmx_call("gmx_sumd");
 592 #else
 593 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 594     if (cr->nc.bUse)
 595     {
 596         if (cr->nc.rank_intra == 0)
 597         {
 598             /* Use two step summing. */
 599             MPI_Reduce(MPI_IN_PLACE, r, nr, MPI_DOUBLE, MPI_SUM, 0,
 600                        cr->nc.comm_intra);
 601             /* Sum the roots of the internal (intra) buffers. */
 602             MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_DOUBLE, MPI_SUM,
 603                           cr->nc.comm_inter);
 604         }
 605         else
 606         {
 607             /* This is here because of the silly MPI specification
 608                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 609             MPI_Reduce(r, NULL, nr, MPI_DOUBLE, MPI_SUM, 0, cr->nc.comm_intra);
 610         }
 611         MPI_Bcast(r, nr, MPI_DOUBLE, 0, cr->nc.comm_intra);
 612     }
 613     else
 614     {
 615         MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_DOUBLE, MPI_SUM,
 616                       cr->mpi_comm_mygroup);
 617     }
 618 #else
 619     int i;
 620
 621     if (nr > cr->mpb->dbuf_alloc)
 622     {
 623         cr->mpb->dbuf_alloc = nr;
 624         srenew(cr->mpb->dbuf, cr->mpb->dbuf_alloc);
 625     }
 626     if (cr->nc.bUse)
 627     {
 628         /* Use two step summing */
 629         MPI_Allreduce(r, cr->mpb->dbuf, nr, MPI_DOUBLE, MPI_SUM, cr->nc.comm_intra);
 630         if (cr->nc.rank_intra == 0)
 631         {
 632             /* Sum with the buffers reversed */
 633             MPI_Allreduce(cr->mpb->dbuf, r, nr, MPI_DOUBLE, MPI_SUM,
 634                           cr->nc.comm_inter);
 635         }
 636         MPI_Bcast(r, nr, MPI_DOUBLE, 0, cr->nc.comm_intra);
 637     }
 638     else
 639     {
 640         MPI_Allreduce(r, cr->mpb->dbuf, nr, MPI_DOUBLE, MPI_SUM,
 641                       cr->mpi_comm_mygroup);
 642         for (i = 0; i < nr; i++)
 643         {
 644             r[i] = cr->mpb->dbuf[i];
 645         }
 646     }
 647 #endif
 648 #endif
 649 }
 650
 651 void gmx_sumf(int nr, float r[], const t_commrec *cr)
 652 {
 653 #ifndef GMX_MPI
 654     gmx_call("gmx_sumf");
 655 #else
 656 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 657     if (cr->nc.bUse)
 658     {
 659         /* Use two step summing.  */
 660         if (cr->nc.rank_intra == 0)
 661         {
 662             MPI_Reduce(MPI_IN_PLACE, r, nr, MPI_FLOAT, MPI_SUM, 0,
 663                        cr->nc.comm_intra);
 664             /* Sum the roots of the internal (intra) buffers */
 665             MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_FLOAT, MPI_SUM,
 666                           cr->nc.comm_inter);
 667         }
 668         else
 669         {
 670             /* This is here because of the silly MPI specification
 671                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 672             MPI_Reduce(r, NULL, nr, MPI_FLOAT, MPI_SUM, 0, cr->nc.comm_intra);
 673         }
 674         MPI_Bcast(r, nr, MPI_FLOAT, 0, cr->nc.comm_intra);
 675     }
 676     else
 677     {
 678         MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_FLOAT, MPI_SUM, cr->mpi_comm_mygroup);
 679     }
 680 #else
 681     int i;
 682
 683     if (nr > cr->mpb->fbuf_alloc)
 684     {
 685         cr->mpb->fbuf_alloc = nr;
 686         srenew(cr->mpb->fbuf, cr->mpb->fbuf_alloc);
 687     }
 688     if (cr->nc.bUse)
 689     {
 690         /* Use two step summing */
 691         MPI_Allreduce(r, cr->mpb->fbuf, nr, MPI_FLOAT, MPI_SUM, cr->nc.comm_intra);
 692         if (cr->nc.rank_intra == 0)
 693         {
 694             /* Sum with the buffers reversed */
 695             MPI_Allreduce(cr->mpb->fbuf, r, nr, MPI_FLOAT, MPI_SUM,
 696                           cr->nc.comm_inter);
 697         }
 698         MPI_Bcast(r, nr, MPI_FLOAT, 0, cr->nc.comm_intra);
 699     }
 700     else
 701     {
 702         MPI_Allreduce(r, cr->mpb->fbuf, nr, MPI_FLOAT, MPI_SUM,
 703                       cr->mpi_comm_mygroup);
 704         for (i = 0; i < nr; i++)
 705         {
 706             r[i] = cr->mpb->fbuf[i];
 707         }
 708     }
 709 #endif
 710 #endif
 711 }
 712
 713 void gmx_sumi(int nr, int r[], const t_commrec *cr)
 714 {
 715 #ifndef GMX_MPI
 716     gmx_call("gmx_sumi");
 717 #else
 718 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 719     if (cr->nc.bUse)
 720     {
 721         /* Use two step summing */
 722         if (cr->nc.rank_intra == 0)
 723         {
 724             MPI_Reduce(MPI_IN_PLACE, r, nr, MPI_INT, MPI_SUM, 0, cr->nc.comm_intra);
 725             /* Sum with the buffers reversed */
 726             MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_INT, MPI_SUM, cr->nc.comm_inter);
 727         }
 728         else
 729         {
 730             /* This is here because of the silly MPI specification
 731                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 732             MPI_Reduce(r, NULL, nr, MPI_INT, MPI_SUM, 0, cr->nc.comm_intra);
 733         }
 734         MPI_Bcast(r, nr, MPI_INT, 0, cr->nc.comm_intra);
 735     }
 736     else
 737     {
 738         MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_INT, MPI_SUM, cr->mpi_comm_mygroup);
 739     }
 740 #else
 741     int i;
 742
 743     if (nr > cr->mpb->ibuf_alloc)
 744     {
 745         cr->mpb->ibuf_alloc = nr;
 746         srenew(cr->mpb->ibuf, cr->mpb->ibuf_alloc);
 747     }
 748     if (cr->nc.bUse)
 749     {
 750         /* Use two step summing */
 751         MPI_Allreduce(r, cr->mpb->ibuf, nr, MPI_INT, MPI_SUM, cr->nc.comm_intra);
 752         if (cr->nc.rank_intra == 0)
 753         {
 754             /* Sum with the buffers reversed */
 755             MPI_Allreduce(cr->mpb->ibuf, r, nr, MPI_INT, MPI_SUM, cr->nc.comm_inter);
 756         }
 757         MPI_Bcast(r, nr, MPI_INT, 0, cr->nc.comm_intra);
 758     }
 759     else
 760     {
 761         MPI_Allreduce(r, cr->mpb->ibuf, nr, MPI_INT, MPI_SUM, cr->mpi_comm_mygroup);
 762         for (i = 0; i < nr; i++)
 763         {
 764             r[i] = cr->mpb->ibuf[i];
 765         }
 766     }
 767 #endif
 768 #endif
 769 }
 770
 771 void gmx_sumli(int nr, gmx_large_int_t r[], const t_commrec *cr)
 772 {
 773 #ifndef GMX_MPI
 774     gmx_call("gmx_sumli");
 775 #else
 776 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 777     if (cr->nc.bUse)
 778     {
 779         /* Use two step summing */
 780         if (cr->nc.rank_intra == 0)
 781         {
 782             MPI_Reduce(MPI_IN_PLACE, r, nr, GMX_MPI_LARGE_INT, MPI_SUM, 0,
 783                        cr->nc.comm_intra);
 784             /* Sum with the buffers reversed */
 785             MPI_Allreduce(MPI_IN_PLACE, r, nr, GMX_MPI_LARGE_INT, MPI_SUM,
 786                           cr->nc.comm_inter);
 787         }
 788         else
 789         {
 790             /* This is here because of the silly MPI specification
 791                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 792             MPI_Reduce(r, NULL, nr, GMX_MPI_LARGE_INT, MPI_SUM, 0, cr->nc.comm_intra);
 793         }
 794         MPI_Bcast(r, nr, GMX_MPI_LARGE_INT, 0, cr->nc.comm_intra);
 795     }
 796     else
 797     {
 798         MPI_Allreduce(MPI_IN_PLACE, r, nr, GMX_MPI_LARGE_INT, MPI_SUM, cr->mpi_comm_mygroup);
 799     }
 800 #else
 801     int i;
 802
 803     if (nr > cr->mpb->libuf_alloc)
 804     {
 805         cr->mpb->libuf_alloc = nr;
 806         srenew(cr->mpb->libuf, cr->mpb->libuf_alloc);
 807     }
 808     if (cr->nc.bUse)
 809     {
 810         /* Use two step summing */
 811         MPI_Allreduce(r, cr->mpb->libuf, nr, GMX_MPI_LARGE_INT, MPI_SUM,
 812                       cr->nc.comm_intra);
 813         if (cr->nc.rank_intra == 0)
 814         {
 815             /* Sum with the buffers reversed */
 816             MPI_Allreduce(cr->mpb->libuf, r, nr, GMX_MPI_LARGE_INT, MPI_SUM,
 817                           cr->nc.comm_inter);
 818         }
 819         MPI_Bcast(r, nr, GMX_MPI_LARGE_INT, 0, cr->nc.comm_intra);
 820     }
 821     else
 822     {
 823         MPI_Allreduce(r, cr->mpb->libuf, nr, GMX_MPI_LARGE_INT, MPI_SUM,
 824                       cr->mpi_comm_mygroup);
 825         for (i = 0; i < nr; i++)
 826         {
 827             r[i] = cr->mpb->libuf[i];
 828         }
 829     }
 830 #endif
 831 #endif
 832 }
 833
 834
 835
 836 #ifdef GMX_MPI
 837 void gmx_sumd_comm(int nr, double r[], MPI_Comm mpi_comm)
 838 {
 839 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 840     MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_DOUBLE, MPI_SUM, mpi_comm);
 841 #else
 842     /* this function is only used in code that is not performance critical,
 843        (during setup, when comm_rec is not the appropriate communication
 844        structure), so this isn't as bad as it looks. */
 845     double *buf;
 846     int     i;
 847
 848     snew(buf, nr);
 849     MPI_Allreduce(r, buf, nr, MPI_DOUBLE, MPI_SUM, mpi_comm);
 850     for (i = 0; i < nr; i++)
 851     {
 852         r[i] = buf[i];
 853     }
 854     sfree(buf);
 855 #endif
 856 }
 857 #endif
 858
 859 #ifdef GMX_MPI
 860 void gmx_sumf_comm(int nr, float r[], MPI_Comm mpi_comm)
 861 {
 862 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 863     MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_FLOAT, MPI_SUM, mpi_comm);
 864 #else
 865     /* this function is only used in code that is not performance critical,
 866        (during setup, when comm_rec is not the appropriate communication
 867        structure), so this isn't as bad as it looks. */
 868     float *buf;
 869     int    i;
 870
 871     snew(buf, nr);
 872     MPI_Allreduce(r, buf, nr, MPI_FLOAT, MPI_SUM, mpi_comm);
 873     for (i = 0; i < nr; i++)
 874     {
 875         r[i] = buf[i];
 876     }
 877     sfree(buf);
 878 #endif
 879 }
 880 #endif
 881
 882 void gmx_sumd_sim(int nr, double r[], const gmx_multisim_t *ms)
 883 {
 884 #ifndef GMX_MPI
 885     gmx_call("gmx_sumd_sim");
 886 #else
 887     gmx_sumd_comm(nr, r, ms->mpi_comm_masters);
 888 #endif
 889 }
 890
 891 void gmx_sumf_sim(int nr, float r[], const gmx_multisim_t *ms)
 892 {
 893 #ifndef GMX_MPI
 894     gmx_call("gmx_sumf_sim");
 895 #else
 896     gmx_sumf_comm(nr, r, ms->mpi_comm_masters);
 897 #endif
 898 }
 899
 900 void gmx_sumi_sim(int nr, int r[], const gmx_multisim_t *ms)
 901 {
 902 #ifndef GMX_MPI
 903     gmx_call("gmx_sumi_sim");
 904 #else
 905 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 906     MPI_Allreduce(MPI_IN_PLACE, r, nr, MPI_INT, MPI_SUM, ms->mpi_comm_masters);
 907 #else
 908     /* this is thread-unsafe, but it will do for now: */
 909     int i;
 910
 911     if (nr > ms->mpb->ibuf_alloc)
 912     {
 913         ms->mpb->ibuf_alloc = nr;
 914         srenew(ms->mpb->ibuf, ms->mpb->ibuf_alloc);
 915     }
 916     MPI_Allreduce(r, ms->mpb->ibuf, nr, MPI_INT, MPI_SUM, ms->mpi_comm_masters);
 917     for (i = 0; i < nr; i++)
 918     {
 919         r[i] = ms->mpb->ibuf[i];
 920     }
 921 #endif
 922 #endif
 923 }
 924
 925 void gmx_sumli_sim(int nr, gmx_large_int_t r[], const gmx_multisim_t *ms)
 926 {
 927 #ifndef GMX_MPI
 928     gmx_call("gmx_sumli_sim");
 929 #else
 930 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 931     MPI_Allreduce(MPI_IN_PLACE, r, nr, GMX_MPI_LARGE_INT, MPI_SUM,
 932                   ms->mpi_comm_masters);
 933 #else
 934     /* this is thread-unsafe, but it will do for now: */
 935     int i;
 936
 937     if (nr > ms->mpb->libuf_alloc)
 938     {
 939         ms->mpb->libuf_alloc = nr;
 940         srenew(ms->mpb->libuf, ms->mpb->libuf_alloc);
 941     }
 942     MPI_Allreduce(r, ms->mpb->libuf, nr, GMX_MPI_LARGE_INT, MPI_SUM,
 943                   ms->mpi_comm_masters);
 944     for (i = 0; i < nr; i++)
 945     {
 946         r[i] = ms->mpb->libuf[i];
 947     }
 948 #endif
 949 #endif
 950 }
 951
 952
 953 void gmx_finalize_par(void)
 954 {
 955 #ifndef GMX_MPI
 956     /* Compiled without MPI, no MPI finalizing needed */
 957     return;
 958 #else
 959     int initialized, finalized;
 960     int ret;
 961
 962     MPI_Initialized(&initialized);
 963     if (!initialized)
 964     {
 965         return;
 966     }
 967     /* just as a check; we don't want to finalize twice */
 968     MPI_Finalized(&finalized);
 969     if (finalized)
 970     {
 971         return;
 972     }
 973
 974     /* We sync the processes here to try to avoid problems
 975      * with buggy MPI implementations that could cause
 976      * unfinished processes to terminate.
 977      */
 978     MPI_Barrier(MPI_COMM_WORLD);
 979
 980     /*
 981        if (DOMAINDECOMP(cr)) {
 982        if (cr->npmenodes > 0 || cr->dd->bCartesian)
 983         MPI_Comm_free(&cr->mpi_comm_mygroup);
 984        if (cr->dd->bCartesian)
 985         MPI_Comm_free(&cr->mpi_comm_mysim);
 986        }
 987      */
 988
 989     /* Apparently certain mpich implementations cause problems
 990      * with MPI_Finalize. In that case comment out MPI_Finalize.
 991      */
 992     if (debug)
 993     {
 994         fprintf(debug, "Will call MPI_Finalize now\n");
 995     }
 996
 997     ret = MPI_Finalize();
 998     if (debug)
 999     {
1000         fprintf(debug, "Return code from MPI_Finalize = %d\n", ret);
1001     }
1002 #endif
1003 }