src/gromacs/gmxlib/network.c

   1 /* -*- mode: c; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; c-file-style: "stroustrup"; -*-
   2  *
   3  *                This source code is part of
   4  *
   5  *                 G   R   O   M   A   C   S
   6  *
   7  *          GROningen MAchine for Chemical Simulations
   8  *
   9  *                        VERSION 3.2.0
  10  * Written by David van der Spoel, Erik Lindahl, Berk Hess, and others.
  11  * Copyright (c) 1991-2000, University of Groningen, The Netherlands.
  12  * Copyright (c) 2001-2004, The GROMACS development team,
  13  * check out http://www.gromacs.org for more information.
  14
  15  * This program is free software; you can redistribute it and/or
  16  * modify it under the terms of the GNU General Public License
  17  * as published by the Free Software Foundation; either version 2
  18  * of the License, or (at your option) any later version.
  19  *
  20  * If you want to redistribute modifications, please consider that
  21  * scientific software is very special. Version control is crucial -
  22  * bugs must be traceable. We will be happy to consider code for
  23  * inclusion in the official distribution, but derived work must not
  24  * be called official GROMACS. Details are found in the README & COPYING
  25  * files - if they are missing, get the official version at www.gromacs.org.
  26  *
  27  * To help us fund GROMACS development, we humbly ask that you cite
  28  * the papers on the package - you can find them in the top README file.
  29  *
  30  * For more info, check our website at http://www.gromacs.org
  31  *
  32  * And Hey:
  33  * GROningen Mixture of Alchemy and Childrens' Stories
  34  */
  35 #ifdef HAVE_CONFIG_H
  36 #include <config.h>
  37 #endif
  38
  39 #include <string.h>
  40 #include "gmx_fatal.h"
  41 #include "main.h"
  42 #include "smalloc.h"
  43 #include "network.h"
  44 #include "copyrite.h"
  45 #include "statutil.h"
  46 #include <ctype.h>
  47 #include "macros.h"
  48
  49 #ifdef GMX_LIB_MPI
  50 #include <mpi.h>
  51 #endif
  52
  53 #ifdef GMX_THREAD_MPI
  54 #include "tmpi.h"
  55 #endif
  56
  57
  58 /* The source code in this file should be thread-safe.
  59       Please keep it that way. */
  60
  61 gmx_bool gmx_mpi_initialized(void)
  62 {
  63   int n;
  64 #ifndef GMX_MPI
  65   return 0;
  66 #else
  67   MPI_Initialized(&n);
  68
  69   return n;
  70 #endif
  71 }
  72
  73 int gmx_setup(int *argc,char **argv,int *nnodes)
  74 {
  75 #ifndef GMX_MPI
  76   gmx_call("gmx_setup");
  77   return 0;
  78 #else
  79   char   buf[256];
  80   int    resultlen;               /* actual length of node name      */
  81   int    i,flag;
  82   int  mpi_num_nodes;
  83   int  mpi_my_rank;
  84   char mpi_hostname[MPI_MAX_PROCESSOR_NAME];
  85
  86   /* Call the MPI routines */
  87 #ifdef GMX_LIB_MPI
  88 #ifdef GMX_FAHCORE
  89   (void) fah_MPI_Init(argc,&argv);
  90 #else
  91   (void) MPI_Init(argc,&argv);
  92 #endif
  93 #endif
  94   (void) MPI_Comm_size( MPI_COMM_WORLD, &mpi_num_nodes );
  95   (void) MPI_Comm_rank( MPI_COMM_WORLD, &mpi_my_rank );
  96   (void) MPI_Get_processor_name( mpi_hostname, &resultlen );
  97
  98 #ifdef GMX_LIB_MPI
  99   fprintf(stderr,"NNODES=%d, MYRANK=%d, HOSTNAME=%s\n",
 100           mpi_num_nodes,mpi_my_rank,mpi_hostname);
 101 #endif
 102
 103   *nnodes=mpi_num_nodes;
 104
 105   return mpi_my_rank;
 106 #endif
 107 }
 108
 109 int  gmx_node_num(void)
 110 {
 111 #ifndef GMX_MPI
 112   return 1;
 113 #else
 114   int i;
 115   (void) MPI_Comm_size(MPI_COMM_WORLD, &i);
 116   return i;
 117 #endif
 118 }
 119
 120 int gmx_node_rank(void)
 121 {
 122 #ifndef GMX_MPI
 123   return 0;
 124 #else
 125   int i;
 126   (void) MPI_Comm_rank(MPI_COMM_WORLD, &i);
 127   return i;
 128 #endif
 129 }
 130
 131
 132 int gmx_hostname_num()
 133 {
 134 #ifndef GMX_MPI
 135   return 0;
 136 #else
 137 #ifdef GMX_THREAD_MPI
 138   /* thread-MPI currently puts the thread number in the process name,
 139    * we might want to change this, as this is inconsistent with what
 140    * most MPI implementations would do when running on a single node.
 141    */
 142   return 0;
 143 #else
 144   int  resultlen,hostnum,i,j;
 145   char mpi_hostname[MPI_MAX_PROCESSOR_NAME],hostnum_str[MPI_MAX_PROCESSOR_NAME];
 146
 147   MPI_Get_processor_name(mpi_hostname,&resultlen);
 148   /* This procedure can only differentiate nodes with host names
 149    * that end on unique numbers.
 150    */
 151   i = 0;
 152   j = 0;
 153   /* Only parse the host name up to the first dot */
 154   while(i < resultlen && mpi_hostname[i] != '.') {
 155     if (isdigit(mpi_hostname[i])) {
 156       hostnum_str[j++] = mpi_hostname[i];
 157     }
 158     i++;
 159   }
 160   hostnum_str[j] = '\0';
 161   if (j == 0) {
 162     hostnum = 0;
 163   } else {
 164     /* Use only the last 9 decimals, so we don't overflow an int */
 165     hostnum = strtol(hostnum_str + max(0,j-9), NULL, 10);
 166   }
 167
 168   if (debug) {
 169     fprintf(debug,"In gmx_setup_nodecomm: hostname '%s', hostnum %d\n",
 170         mpi_hostname,hostnum);
 171   }
 172   return hostnum;
 173 #endif
 174 #endif
 175 }
 176
 177 void gmx_setup_nodecomm(FILE *fplog,t_commrec *cr)
 178 {
 179     gmx_nodecomm_t *nc;
 180     int  n,rank,hostnum,ng,ni;
 181
 182     /* Many MPI implementations do not optimize MPI_Allreduce
 183      * (and probably also other global communication calls)
 184      * for multi-core nodes connected by a network.
 185      * We can optimize such communication by using one MPI call
 186      * within each node and one between the nodes.
 187      * For MVAPICH2 and Intel MPI this reduces the time for
 188      * the global_stat communication by 25%
 189      * for 2x2-core 3 GHz Woodcrest connected by mixed DDR/SDR Infiniband.
 190      * B. Hess, November 2007
 191      */
 192
 193     nc = &cr->nc;
 194
 195     nc->bUse = FALSE;
 196 #ifndef GMX_THREAD_MPI
 197 #ifdef GMX_MPI
 198     MPI_Comm_size(cr->mpi_comm_mygroup,&n);
 199     MPI_Comm_rank(cr->mpi_comm_mygroup,&rank);
 200
 201     hostnum = gmx_hostname_num();
 202
 203     if (debug)
 204     {
 205         fprintf(debug,"In gmx_setup_nodecomm: splitting communicator of size %d\n",n);
 206     }
 207
 208
 209     /* The intra-node communicator, split on node number */
 210     MPI_Comm_split(cr->mpi_comm_mygroup,hostnum,rank,&nc->comm_intra);
 211     MPI_Comm_rank(nc->comm_intra,&nc->rank_intra);
 212     if (debug)
 213     {
 214         fprintf(debug,"In gmx_setup_nodecomm: node rank %d rank_intra %d\n",
 215                 rank,nc->rank_intra);
 216     }
 217     /* The inter-node communicator, split on rank_intra.
 218      * We actually only need the one for rank=0,
 219      * but it is easier to create them all.
 220      */
 221     MPI_Comm_split(cr->mpi_comm_mygroup,nc->rank_intra,rank,&nc->comm_inter);
 222     /* Check if this really created two step communication */
 223     MPI_Comm_size(nc->comm_inter,&ng);
 224     MPI_Comm_size(nc->comm_intra,&ni);
 225     if (debug)
 226     {
 227         fprintf(debug,"In gmx_setup_nodecomm: groups %d, my group size %d\n",
 228                 ng,ni);
 229     }
 230
 231     if (getenv("GMX_NO_NODECOMM") == NULL &&
 232         ((ng > 1 && ng < n) || (ni > 1 && ni < n)))
 233     {
 234         nc->bUse = TRUE;
 235         if (fplog)
 236         {
 237             fprintf(fplog,"Using two step summing over %d groups of on average %.1f processes\n\n",
 238                     ng,(real)n/(real)ng);
 239         }
 240         if (nc->rank_intra > 0)
 241         {
 242             MPI_Comm_free(&nc->comm_inter);
 243         }
 244     }
 245     else
 246     {
 247         /* One group or all processes in a separate group, use normal summing */
 248         MPI_Comm_free(&nc->comm_inter);
 249         MPI_Comm_free(&nc->comm_intra);
 250         if (debug)
 251         {
 252             fprintf(debug,"In gmx_setup_nodecomm: not unsing separate inter- and intra-node communicators.\n");
 253         }
 254     }
 255 #endif
 256 #else
 257     /* tMPI runs only on a single node so just use the nodeid */
 258     nc->rank_intra = cr->nodeid;
 259 #endif
 260 }
 261
 262 void gmx_init_intranode_counters(t_commrec *cr)
 263 {
 264     /* counters for PP+PME and PP-only processes on my physical node */
 265     int nrank_intranode, rank_intranode;
 266     int nrank_pp_intranode, rank_pp_intranode;
 267     /* thread-MPI is not initialized when not running in parallel */
 268 #if defined GMX_MPI && !defined GMX_THREAD_MPI
 269     int nrank_world, rank_world;
 270     int i, mynum, *num, *num_s, *num_pp, *num_pp_s;
 271
 272     MPI_Comm_size(MPI_COMM_WORLD,&nrank_world);
 273     MPI_Comm_rank(MPI_COMM_WORLD,&rank_world);
 274
 275     /* Get the node number from the hostname to identify the nodes */
 276     mynum = gmx_hostname_num();
 277
 278     /* We can't rely on MPI_IN_PLACE, so we need send and receive buffers */
 279     snew(num,   nrank_world);
 280     snew(num_s, nrank_world);
 281     snew(num_pp,   nrank_world);
 282     snew(num_pp_s, nrank_world);
 283
 284     num_s[rank_world]    = mynum;
 285     num_pp_s[rank_world] = (cr->duty & DUTY_PP) ? mynum : -1;
 286
 287     MPI_Allreduce(num_s,    num,    nrank_world, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
 288     MPI_Allreduce(num_pp_s, num_pp, nrank_world, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
 289
 290     nrank_intranode    = 0;
 291     rank_intranode     = 0;
 292     nrank_pp_intranode = 0;
 293     rank_pp_intranode  = 0;
 294     for(i=0; i<nrank_world; i++)
 295     {
 296         if (num[i] == mynum)
 297         {
 298             nrank_intranode++;
 299             if (i < rank_world)
 300             {
 301                 rank_intranode++;
 302             }
 303         }
 304         if ((cr->duty & DUTY_PP) && num_pp[i] == mynum)
 305         {
 306             nrank_pp_intranode++;
 307             if (i < rank_world)
 308             {
 309                 rank_pp_intranode++;
 310             }
 311         }
 312     }
 313     sfree(num);
 314     sfree(num_s);
 315     sfree(num_pp);
 316     sfree(num_pp_s);
 317 #else
 318     /* Serial or thread-MPI code: we run within a single physical node */
 319     nrank_intranode    = cr->nnodes;
 320     rank_intranode     = cr->sim_nodeid;
 321     nrank_pp_intranode = cr->nnodes - cr->npmenodes;
 322     rank_pp_intranode  = cr->nodeid;
 323 #endif
 324
 325     if (debug)
 326     {
 327         char sbuf[STRLEN];
 328         if (cr->duty & DUTY_PP && cr->duty & DUTY_PME)
 329         {
 330             sprintf(sbuf, "PP+PME");
 331         }
 332         else
 333         {
 334             sprintf(sbuf, "%s", cr->duty & DUTY_PP ? "PP" : "PME");
 335         }
 336         fprintf(debug, "On %3s node %d: nrank_intranode=%d, rank_intranode=%d, "
 337                 "nrank_pp_intranode=%d, rank_pp_intranode=%d\n",
 338                 sbuf, cr->sim_nodeid,
 339                 nrank_intranode, rank_intranode,
 340                 nrank_pp_intranode, rank_pp_intranode);
 341     }
 342
 343     cr->nrank_intranode    = nrank_intranode;
 344     cr->rank_intranode     = rank_intranode;
 345     cr->nrank_pp_intranode = nrank_pp_intranode;
 346     cr->rank_pp_intranode  = rank_pp_intranode;
 347 }
 348
 349
 350 void gmx_barrier(const t_commrec *cr)
 351 {
 352 #ifndef GMX_MPI
 353   gmx_call("gmx_barrier");
 354 #else
 355   MPI_Barrier(cr->mpi_comm_mygroup);
 356 #endif
 357 }
 358
 359 void gmx_abort(int noderank,int nnodes,int errorno)
 360 {
 361 #ifndef GMX_MPI
 362   gmx_call("gmx_abort");
 363 #else
 364 #ifdef GMX_THREAD_MPI
 365   fprintf(stderr,"Halting program %s\n",ShortProgram());
 366   thanx(stderr);
 367   exit(1);
 368 #else
 369   if (nnodes > 1)
 370   {
 371       fprintf(stderr,"Halting parallel program %s on CPU %d out of %d\n",
 372               ShortProgram(),noderank,nnodes);
 373   }
 374   else
 375   {
 376       fprintf(stderr,"Halting program %s\n",ShortProgram());
 377   }
 378
 379   thanx(stderr);
 380   MPI_Abort(MPI_COMM_WORLD,errorno);
 381   exit(1);
 382 #endif
 383 #endif
 384 }
 385
 386 void gmx_bcast(int nbytes,void *b,const t_commrec *cr)
 387 {
 388 #ifndef GMX_MPI
 389   gmx_call("gmx_bast");
 390 #else
 391   MPI_Bcast(b,nbytes,MPI_BYTE,MASTERRANK(cr),cr->mpi_comm_mygroup);
 392 #endif
 393 }
 394
 395 void gmx_bcast_sim(int nbytes,void *b,const t_commrec *cr)
 396 {
 397 #ifndef GMX_MPI
 398   gmx_call("gmx_bast");
 399 #else
 400   MPI_Bcast(b,nbytes,MPI_BYTE,MASTERRANK(cr),cr->mpi_comm_mysim);
 401 #endif
 402 }
 403
 404 void gmx_sumd(int nr,double r[],const t_commrec *cr)
 405 {
 406 #ifndef GMX_MPI
 407     gmx_call("gmx_sumd");
 408 #else
 409 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 410     if (cr->nc.bUse) {
 411         if (cr->nc.rank_intra == 0)
 412         {
 413             /* Use two step summing. */
 414             MPI_Reduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,0,
 415                        cr->nc.comm_intra);
 416             /* Sum the roots of the internal (intra) buffers. */
 417             MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,
 418                           cr->nc.comm_inter);
 419         }
 420         else
 421         {
 422             /* This is here because of the silly MPI specification
 423                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 424             MPI_Reduce(r,NULL,nr,MPI_DOUBLE,MPI_SUM,0,cr->nc.comm_intra);
 425         }
 426         MPI_Bcast(r,nr,MPI_DOUBLE,0,cr->nc.comm_intra);
 427     }
 428     else
 429     {
 430         MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,
 431                       cr->mpi_comm_mygroup);
 432     }
 433 #else
 434     int i;
 435
 436     if (nr > cr->mpb->dbuf_alloc) {
 437         cr->mpb->dbuf_alloc = nr;
 438         srenew(cr->mpb->dbuf,cr->mpb->dbuf_alloc);
 439     }
 440     if (cr->nc.bUse) {
 441         /* Use two step summing */
 442         MPI_Allreduce(r,cr->mpb->dbuf,nr,MPI_DOUBLE,MPI_SUM,cr->nc.comm_intra);
 443         if (cr->nc.rank_intra == 0) {
 444             /* Sum with the buffers reversed */
 445             MPI_Allreduce(cr->mpb->dbuf,r,nr,MPI_DOUBLE,MPI_SUM,
 446                           cr->nc.comm_inter);
 447         }
 448         MPI_Bcast(r,nr,MPI_DOUBLE,0,cr->nc.comm_intra);
 449     } else {
 450         MPI_Allreduce(r,cr->mpb->dbuf,nr,MPI_DOUBLE,MPI_SUM,
 451                       cr->mpi_comm_mygroup);
 452         for(i=0; i<nr; i++)
 453             r[i] = cr->mpb->dbuf[i];
 454     }
 455 #endif
 456 #endif
 457 }
 458
 459 void gmx_sumf(int nr,float r[],const t_commrec *cr)
 460 {
 461 #ifndef GMX_MPI
 462     gmx_call("gmx_sumf");
 463 #else
 464 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 465     if (cr->nc.bUse) {
 466         /* Use two step summing.  */
 467         if (cr->nc.rank_intra == 0)
 468         {
 469             MPI_Reduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,0,
 470                        cr->nc.comm_intra);
 471             /* Sum the roots of the internal (intra) buffers */
 472             MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,
 473                           cr->nc.comm_inter);
 474         }
 475         else
 476         {
 477             /* This is here because of the silly MPI specification
 478                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 479             MPI_Reduce(r,NULL,nr,MPI_FLOAT,MPI_SUM,0,cr->nc.comm_intra);
 480         }
 481         MPI_Bcast(r,nr,MPI_FLOAT,0,cr->nc.comm_intra);
 482     }
 483     else
 484     {
 485         MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,cr->mpi_comm_mygroup);
 486     }
 487 #else
 488     int i;
 489
 490     if (nr > cr->mpb->fbuf_alloc) {
 491         cr->mpb->fbuf_alloc = nr;
 492         srenew(cr->mpb->fbuf,cr->mpb->fbuf_alloc);
 493     }
 494     if (cr->nc.bUse) {
 495         /* Use two step summing */
 496         MPI_Allreduce(r,cr->mpb->fbuf,nr,MPI_FLOAT,MPI_SUM,cr->nc.comm_intra);
 497         if (cr->nc.rank_intra == 0) {
 498             /* Sum with the buffers reversed */
 499             MPI_Allreduce(cr->mpb->fbuf,r,nr,MPI_FLOAT,MPI_SUM,
 500                           cr->nc.comm_inter);
 501         }
 502         MPI_Bcast(r,nr,MPI_FLOAT,0,cr->nc.comm_intra);
 503     } else {
 504         MPI_Allreduce(r,cr->mpb->fbuf,nr,MPI_FLOAT,MPI_SUM,
 505                       cr->mpi_comm_mygroup);
 506         for(i=0; i<nr; i++)
 507             r[i] = cr->mpb->fbuf[i];
 508     }
 509 #endif
 510 #endif
 511 }
 512
 513 void gmx_sumi(int nr,int r[],const t_commrec *cr)
 514 {
 515 #ifndef GMX_MPI
 516     gmx_call("gmx_sumi");
 517 #else
 518 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 519     if (cr->nc.bUse) {
 520         /* Use two step summing */
 521         if (cr->nc.rank_intra == 0)
 522         {
 523             MPI_Reduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,0,cr->nc.comm_intra);
 524             /* Sum with the buffers reversed */
 525             MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,cr->nc.comm_inter);
 526         }
 527         else
 528         {
 529             /* This is here because of the silly MPI specification
 530                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 531             MPI_Reduce(r,NULL,nr,MPI_INT,MPI_SUM,0,cr->nc.comm_intra);
 532         }
 533         MPI_Bcast(r,nr,MPI_INT,0,cr->nc.comm_intra);
 534     }
 535     else
 536     {
 537         MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,cr->mpi_comm_mygroup);
 538     }
 539 #else
 540     int i;
 541
 542     if (nr > cr->mpb->ibuf_alloc) {
 543         cr->mpb->ibuf_alloc = nr;
 544         srenew(cr->mpb->ibuf,cr->mpb->ibuf_alloc);
 545     }
 546     if (cr->nc.bUse) {
 547         /* Use two step summing */
 548         MPI_Allreduce(r,cr->mpb->ibuf,nr,MPI_INT,MPI_SUM,cr->nc.comm_intra);
 549         if (cr->nc.rank_intra == 0) {
 550             /* Sum with the buffers reversed */
 551             MPI_Allreduce(cr->mpb->ibuf,r,nr,MPI_INT,MPI_SUM,cr->nc.comm_inter);
 552         }
 553         MPI_Bcast(r,nr,MPI_INT,0,cr->nc.comm_intra);
 554     } else {
 555         MPI_Allreduce(r,cr->mpb->ibuf,nr,MPI_INT,MPI_SUM,cr->mpi_comm_mygroup);
 556         for(i=0; i<nr; i++)
 557             r[i] = cr->mpb->ibuf[i];
 558     }
 559 #endif
 560 #endif
 561 }
 562
 563 void gmx_sumli(int nr,gmx_large_int_t r[],const t_commrec *cr)
 564 {
 565 #ifndef GMX_MPI
 566     gmx_call("gmx_sumli");
 567 #else
 568 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 569     if (cr->nc.bUse) {
 570         /* Use two step summing */
 571         if (cr->nc.rank_intra == 0)
 572         {
 573             MPI_Reduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,0,
 574                        cr->nc.comm_intra);
 575             /* Sum with the buffers reversed */
 576             MPI_Allreduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 577                           cr->nc.comm_inter);
 578         }
 579         else
 580         {
 581             /* This is here because of the silly MPI specification
 582                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 583             MPI_Reduce(r,NULL,nr,GMX_MPI_LARGE_INT,MPI_SUM,0,cr->nc.comm_intra);
 584         }
 585         MPI_Bcast(r,nr,GMX_MPI_LARGE_INT,0,cr->nc.comm_intra);
 586     }
 587     else
 588     {
 589         MPI_Allreduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,cr->mpi_comm_mygroup);
 590     }
 591 #else
 592     int i;
 593
 594     if (nr > cr->mpb->libuf_alloc) {
 595         cr->mpb->libuf_alloc = nr;
 596         srenew(cr->mpb->libuf,cr->mpb->libuf_alloc);
 597     }
 598     if (cr->nc.bUse) {
 599         /* Use two step summing */
 600         MPI_Allreduce(r,cr->mpb->libuf,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 601                       cr->nc.comm_intra);
 602         if (cr->nc.rank_intra == 0) {
 603             /* Sum with the buffers reversed */
 604             MPI_Allreduce(cr->mpb->libuf,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 605                           cr->nc.comm_inter);
 606         }
 607         MPI_Bcast(r,nr,GMX_MPI_LARGE_INT,0,cr->nc.comm_intra);
 608     } else {
 609         MPI_Allreduce(r,cr->mpb->libuf,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 610                       cr->mpi_comm_mygroup);
 611         for(i=0; i<nr; i++)
 612             r[i] = cr->mpb->libuf[i];
 613     }
 614 #endif
 615 #endif
 616 }
 617
 618
 619
 620 #ifdef GMX_MPI
 621 void gmx_sumd_comm(int nr,double r[],MPI_Comm mpi_comm)
 622 {
 623 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 624     MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,mpi_comm);
 625 #else
 626     /* this function is only used in code that is not performance critical,
 627        (during setup, when comm_rec is not the appropriate communication
 628        structure), so this isn't as bad as it looks. */
 629     double *buf;
 630     int i;
 631
 632     snew(buf, nr);
 633     MPI_Allreduce(r,buf,nr,MPI_DOUBLE,MPI_SUM,mpi_comm);
 634     for(i=0; i<nr; i++)
 635         r[i] = buf[i];
 636     sfree(buf);
 637 #endif
 638 }
 639 #endif
 640
 641 #ifdef GMX_MPI
 642 void gmx_sumf_comm(int nr,float r[],MPI_Comm mpi_comm)
 643 {
 644 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 645     MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,mpi_comm);
 646 #else
 647     /* this function is only used in code that is not performance critical,
 648        (during setup, when comm_rec is not the appropriate communication
 649        structure), so this isn't as bad as it looks. */
 650     float *buf;
 651     int i;
 652
 653     snew(buf, nr);
 654     MPI_Allreduce(r,buf,nr,MPI_FLOAT,MPI_SUM,mpi_comm);
 655     for(i=0; i<nr; i++)
 656         r[i] = buf[i];
 657     sfree(buf);
 658 #endif
 659 }
 660 #endif
 661
 662 void gmx_sumd_sim(int nr,double r[],const gmx_multisim_t *ms)
 663 {
 664 #ifndef GMX_MPI
 665   gmx_call("gmx_sumd_sim");
 666 #else
 667   gmx_sumd_comm(nr,r,ms->mpi_comm_masters);
 668 #endif
 669 }
 670
 671 void gmx_sumf_sim(int nr,float r[],const gmx_multisim_t *ms)
 672 {
 673 #ifndef GMX_MPI
 674   gmx_call("gmx_sumf_sim");
 675 #else
 676   gmx_sumf_comm(nr,r,ms->mpi_comm_masters);
 677 #endif
 678 }
 679
 680 void gmx_sumi_sim(int nr,int r[], const gmx_multisim_t *ms)
 681 {
 682 #ifndef GMX_MPI
 683     gmx_call("gmx_sumi_sim");
 684 #else
 685 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 686     MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,ms->mpi_comm_masters);
 687 #else
 688     /* this is thread-unsafe, but it will do for now: */
 689     int i;
 690
 691     if (nr > ms->mpb->ibuf_alloc) {
 692         ms->mpb->ibuf_alloc = nr;
 693         srenew(ms->mpb->ibuf,ms->mpb->ibuf_alloc);
 694     }
 695     MPI_Allreduce(r,ms->mpb->ibuf,nr,MPI_INT,MPI_SUM,ms->mpi_comm_masters);
 696     for(i=0; i<nr; i++)
 697         r[i] = ms->mpb->ibuf[i];
 698 #endif
 699 #endif
 700 }
 701
 702 void gmx_sumli_sim(int nr,gmx_large_int_t r[], const gmx_multisim_t *ms)
 703 {
 704 #ifndef GMX_MPI
 705     gmx_call("gmx_sumli_sim");
 706 #else
 707 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 708     MPI_Allreduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 709                   ms->mpi_comm_masters);
 710 #else
 711     /* this is thread-unsafe, but it will do for now: */
 712     int i;
 713
 714     if (nr > ms->mpb->libuf_alloc) {
 715         ms->mpb->libuf_alloc = nr;
 716         srenew(ms->mpb->libuf,ms->mpb->libuf_alloc);
 717     }
 718     MPI_Allreduce(r,ms->mpb->libuf,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 719                   ms->mpi_comm_masters);
 720     for(i=0; i<nr; i++)
 721         r[i] = ms->mpb->libuf[i];
 722 #endif
 723 #endif
 724 }
 725
 726
 727 void gmx_finalize_par(void)
 728 {
 729 #ifndef GMX_MPI
 730     /* Compiled without MPI, no MPI finalizing needed */
 731     return;
 732 #else
 733     int initialized,finalized;
 734     int ret;
 735
 736     MPI_Initialized(&initialized);
 737     if (!initialized)
 738     {
 739         return;
 740     }
 741     /* just as a check; we don't want to finalize twice */
 742     MPI_Finalized(&finalized);
 743     if (finalized)
 744     {
 745         return;
 746     }
 747
 748   /* We sync the processes here to try to avoid problems
 749    * with buggy MPI implementations that could cause
 750    * unfinished processes to terminate.
 751    */
 752   MPI_Barrier(MPI_COMM_WORLD);
 753
 754   /*
 755   if (DOMAINDECOMP(cr)) {
 756     if (cr->npmenodes > 0 || cr->dd->bCartesian)
 757       MPI_Comm_free(&cr->mpi_comm_mygroup);
 758     if (cr->dd->bCartesian)
 759       MPI_Comm_free(&cr->mpi_comm_mysim);
 760   }
 761   */
 762
 763   /* Apparently certain mpich implementations cause problems
 764    * with MPI_Finalize. In that case comment out MPI_Finalize.
 765    */
 766   if (debug)
 767     fprintf(debug,"Will call MPI_Finalize now\n");
 768
 769   ret = MPI_Finalize();
 770   if (debug)
 771     fprintf(debug,"Return code from MPI_Finalize = %d\n",ret);
 772 #endif
 773 }
 774