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_intra_counters(t_commrec *cr)
 263 {
 264     /* counters for PP+PME and PP-only processes on my node */
 265     int nnodes, nnodes_pp, id_mynode=-1, id_mynode_group=-1, nproc_mynode, nproc_mynode_pp;
 266 #if defined GMX_MPI && !defined GMX_THREAD_MPI
 267     int i, mynum, *num, *num_s, *num_pp, *num_pp_s;
 268 #endif
 269
 270     nnodes    = cr->nnodes;
 271     nnodes_pp = nnodes - cr->npmenodes;
 272
 273 #if defined GMX_MPI && !defined GMX_THREAD_MPI
 274     /* We have MPI and can expect to have different compute nodes */
 275     mynum = gmx_hostname_num();
 276
 277     /* We can't rely on MPI_IN_PLACE, so we need send and receive buffers */
 278     snew(num,   nnodes);
 279     snew(num_s, nnodes);
 280     snew(num_pp,   nnodes_pp);
 281     snew(num_pp_s, nnodes_pp);
 282
 283     num_s[cr->sim_nodeid] = mynum;
 284     if (cr->duty & DUTY_PP)
 285     {
 286         num_pp_s[cr->nodeid] = mynum;
 287     }
 288
 289     MPI_Allreduce(num_s, num, nnodes, MPI_INT, MPI_SUM, cr->mpi_comm_mysim);
 290     MPI_Allreduce(num_pp_s, num_pp, nnodes_pp, MPI_INT, MPI_SUM, cr->mpi_comm_mygroup);
 291
 292     id_mynode       = 0;
 293     id_mynode_group = 0;
 294     nproc_mynode    = 0;
 295     nproc_mynode_pp = 0;
 296     for(i=0; i<nnodes; i++)
 297     {
 298         if (num[i] == mynum)
 299         {
 300             nproc_mynode++;
 301             if (i < cr->sim_nodeid)
 302             {
 303                 id_mynode++;
 304             }
 305             if (i < cr->nodeid)
 306             {
 307                 id_mynode_group++;
 308             }
 309         }
 310     }
 311     for(i=0; i<nnodes_pp; i++)
 312     {
 313         if (num_pp[i] == mynum)
 314         {
 315             nproc_mynode_pp++;
 316         }
 317     }
 318     sfree(num);
 319     sfree(num_s);
 320     sfree(num_pp);
 321     sfree(num_pp_s);
 322 #else
 323     /* Serial or thread-MPI code, we are running within a node */
 324     id_mynode       = cr->sim_nodeid;
 325     id_mynode_group = cr->nodeid;
 326     nproc_mynode    = cr->nnodes;
 327     nproc_mynode_pp = cr->nnodes - cr->npmenodes;
 328 #endif
 329
 330     if (debug)
 331     {
 332         char sbuf[STRLEN];
 333         if (cr->duty & DUTY_PP && cr->duty & DUTY_PME)
 334         {
 335             sprintf(sbuf, "PP+PME");
 336         }
 337         else
 338         {
 339             sprintf(sbuf, "%s", cr->duty & DUTY_PP ? "PP" : "PME");
 340         }
 341         fprintf(debug, "On %3s node %d: nodeid_intra=%d, nodeid_group_intra=%d, "
 342                 "nnodes_intra=%d, nnodes_pp_intra=%d\n", sbuf, cr->sim_nodeid,
 343                 id_mynode, id_mynode_group, nproc_mynode, nproc_mynode_pp);
 344     }
 345
 346     cr->nodeid_intra        = id_mynode;
 347     cr->nodeid_group_intra  = id_mynode_group;
 348     cr->nnodes_intra        = nproc_mynode;
 349     cr->nnodes_pp_intra     = nproc_mynode_pp;
 350 }
 351
 352
 353 void gmx_barrier(const t_commrec *cr)
 354 {
 355 #ifndef GMX_MPI
 356   gmx_call("gmx_barrier");
 357 #else
 358   MPI_Barrier(cr->mpi_comm_mygroup);
 359 #endif
 360 }
 361
 362 void gmx_abort(int noderank,int nnodes,int errorno)
 363 {
 364 #ifndef GMX_MPI
 365   gmx_call("gmx_abort");
 366 #else
 367 #ifdef GMX_THREAD_MPI
 368   fprintf(stderr,"Halting program %s\n",ShortProgram());
 369   thanx(stderr);
 370   exit(1);
 371 #else
 372   if (nnodes > 1)
 373   {
 374       fprintf(stderr,"Halting parallel program %s on CPU %d out of %d\n",
 375               ShortProgram(),noderank,nnodes);
 376   }
 377   else
 378   {
 379       fprintf(stderr,"Halting program %s\n",ShortProgram());
 380   }
 381
 382   thanx(stderr);
 383   MPI_Abort(MPI_COMM_WORLD,errorno);
 384   exit(1);
 385 #endif
 386 #endif
 387 }
 388
 389 void gmx_bcast(int nbytes,void *b,const t_commrec *cr)
 390 {
 391 #ifndef GMX_MPI
 392   gmx_call("gmx_bast");
 393 #else
 394   MPI_Bcast(b,nbytes,MPI_BYTE,MASTERRANK(cr),cr->mpi_comm_mygroup);
 395 #endif
 396 }
 397
 398 void gmx_bcast_sim(int nbytes,void *b,const t_commrec *cr)
 399 {
 400 #ifndef GMX_MPI
 401   gmx_call("gmx_bast");
 402 #else
 403   MPI_Bcast(b,nbytes,MPI_BYTE,MASTERRANK(cr),cr->mpi_comm_mysim);
 404 #endif
 405 }
 406
 407 void gmx_sumd(int nr,double r[],const t_commrec *cr)
 408 {
 409 #ifndef GMX_MPI
 410     gmx_call("gmx_sumd");
 411 #else
 412 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 413     if (cr->nc.bUse) {
 414         if (cr->nc.rank_intra == 0)
 415         {
 416             /* Use two step summing. */
 417             MPI_Reduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,0,
 418                        cr->nc.comm_intra);
 419             /* Sum the roots of the internal (intra) buffers. */
 420             MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,
 421                           cr->nc.comm_inter);
 422         }
 423         else
 424         {
 425             /* This is here because of the silly MPI specification
 426                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 427             MPI_Reduce(r,NULL,nr,MPI_DOUBLE,MPI_SUM,0,cr->nc.comm_intra);
 428         }
 429         MPI_Bcast(r,nr,MPI_DOUBLE,0,cr->nc.comm_intra);
 430     }
 431     else
 432     {
 433         MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,
 434                       cr->mpi_comm_mygroup);
 435     }
 436 #else
 437     int i;
 438
 439     if (nr > cr->mpb->dbuf_alloc) {
 440         cr->mpb->dbuf_alloc = nr;
 441         srenew(cr->mpb->dbuf,cr->mpb->dbuf_alloc);
 442     }
 443     if (cr->nc.bUse) {
 444         /* Use two step summing */
 445         MPI_Allreduce(r,cr->mpb->dbuf,nr,MPI_DOUBLE,MPI_SUM,cr->nc.comm_intra);
 446         if (cr->nc.rank_intra == 0) {
 447             /* Sum with the buffers reversed */
 448             MPI_Allreduce(cr->mpb->dbuf,r,nr,MPI_DOUBLE,MPI_SUM,
 449                           cr->nc.comm_inter);
 450         }
 451         MPI_Bcast(r,nr,MPI_DOUBLE,0,cr->nc.comm_intra);
 452     } else {
 453         MPI_Allreduce(r,cr->mpb->dbuf,nr,MPI_DOUBLE,MPI_SUM,
 454                       cr->mpi_comm_mygroup);
 455         for(i=0; i<nr; i++)
 456             r[i] = cr->mpb->dbuf[i];
 457     }
 458 #endif
 459 #endif
 460 }
 461
 462 void gmx_sumf(int nr,float r[],const t_commrec *cr)
 463 {
 464 #ifndef GMX_MPI
 465     gmx_call("gmx_sumf");
 466 #else
 467 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 468     if (cr->nc.bUse) {
 469         /* Use two step summing.  */
 470         if (cr->nc.rank_intra == 0)
 471         {
 472             MPI_Reduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,0,
 473                        cr->nc.comm_intra);
 474             /* Sum the roots of the internal (intra) buffers */
 475             MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,
 476                           cr->nc.comm_inter);
 477         }
 478         else
 479         {
 480             /* This is here because of the silly MPI specification
 481                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 482             MPI_Reduce(r,NULL,nr,MPI_FLOAT,MPI_SUM,0,cr->nc.comm_intra);
 483         }
 484         MPI_Bcast(r,nr,MPI_FLOAT,0,cr->nc.comm_intra);
 485     }
 486     else
 487     {
 488         MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,cr->mpi_comm_mygroup);
 489     }
 490 #else
 491     int i;
 492
 493     if (nr > cr->mpb->fbuf_alloc) {
 494         cr->mpb->fbuf_alloc = nr;
 495         srenew(cr->mpb->fbuf,cr->mpb->fbuf_alloc);
 496     }
 497     if (cr->nc.bUse) {
 498         /* Use two step summing */
 499         MPI_Allreduce(r,cr->mpb->fbuf,nr,MPI_FLOAT,MPI_SUM,cr->nc.comm_intra);
 500         if (cr->nc.rank_intra == 0) {
 501             /* Sum with the buffers reversed */
 502             MPI_Allreduce(cr->mpb->fbuf,r,nr,MPI_FLOAT,MPI_SUM,
 503                           cr->nc.comm_inter);
 504         }
 505         MPI_Bcast(r,nr,MPI_FLOAT,0,cr->nc.comm_intra);
 506     } else {
 507         MPI_Allreduce(r,cr->mpb->fbuf,nr,MPI_FLOAT,MPI_SUM,
 508                       cr->mpi_comm_mygroup);
 509         for(i=0; i<nr; i++)
 510             r[i] = cr->mpb->fbuf[i];
 511     }
 512 #endif
 513 #endif
 514 }
 515
 516 void gmx_sumi(int nr,int r[],const t_commrec *cr)
 517 {
 518 #ifndef GMX_MPI
 519     gmx_call("gmx_sumi");
 520 #else
 521 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 522     if (cr->nc.bUse) {
 523         /* Use two step summing */
 524         if (cr->nc.rank_intra == 0)
 525         {
 526             MPI_Reduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,0,cr->nc.comm_intra);
 527             /* Sum with the buffers reversed */
 528             MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,cr->nc.comm_inter);
 529         }
 530         else
 531         {
 532             /* This is here because of the silly MPI specification
 533                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 534             MPI_Reduce(r,NULL,nr,MPI_INT,MPI_SUM,0,cr->nc.comm_intra);
 535         }
 536         MPI_Bcast(r,nr,MPI_INT,0,cr->nc.comm_intra);
 537     }
 538     else
 539     {
 540         MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,cr->mpi_comm_mygroup);
 541     }
 542 #else
 543     int i;
 544
 545     if (nr > cr->mpb->ibuf_alloc) {
 546         cr->mpb->ibuf_alloc = nr;
 547         srenew(cr->mpb->ibuf,cr->mpb->ibuf_alloc);
 548     }
 549     if (cr->nc.bUse) {
 550         /* Use two step summing */
 551         MPI_Allreduce(r,cr->mpb->ibuf,nr,MPI_INT,MPI_SUM,cr->nc.comm_intra);
 552         if (cr->nc.rank_intra == 0) {
 553             /* Sum with the buffers reversed */
 554             MPI_Allreduce(cr->mpb->ibuf,r,nr,MPI_INT,MPI_SUM,cr->nc.comm_inter);
 555         }
 556         MPI_Bcast(r,nr,MPI_INT,0,cr->nc.comm_intra);
 557     } else {
 558         MPI_Allreduce(r,cr->mpb->ibuf,nr,MPI_INT,MPI_SUM,cr->mpi_comm_mygroup);
 559         for(i=0; i<nr; i++)
 560             r[i] = cr->mpb->ibuf[i];
 561     }
 562 #endif
 563 #endif
 564 }
 565
 566 void gmx_sumli(int nr,gmx_large_int_t r[],const t_commrec *cr)
 567 {
 568 #ifndef GMX_MPI
 569     gmx_call("gmx_sumli");
 570 #else
 571 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 572     if (cr->nc.bUse) {
 573         /* Use two step summing */
 574         if (cr->nc.rank_intra == 0)
 575         {
 576             MPI_Reduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,0,
 577                        cr->nc.comm_intra);
 578             /* Sum with the buffers reversed */
 579             MPI_Allreduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 580                           cr->nc.comm_inter);
 581         }
 582         else
 583         {
 584             /* This is here because of the silly MPI specification
 585                 that MPI_IN_PLACE should be put in sendbuf instead of recvbuf */
 586             MPI_Reduce(r,NULL,nr,GMX_MPI_LARGE_INT,MPI_SUM,0,cr->nc.comm_intra);
 587         }
 588         MPI_Bcast(r,nr,GMX_MPI_LARGE_INT,0,cr->nc.comm_intra);
 589     }
 590     else
 591     {
 592         MPI_Allreduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,cr->mpi_comm_mygroup);
 593     }
 594 #else
 595     int i;
 596
 597     if (nr > cr->mpb->libuf_alloc) {
 598         cr->mpb->libuf_alloc = nr;
 599         srenew(cr->mpb->libuf,cr->mpb->libuf_alloc);
 600     }
 601     if (cr->nc.bUse) {
 602         /* Use two step summing */
 603         MPI_Allreduce(r,cr->mpb->libuf,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 604                       cr->nc.comm_intra);
 605         if (cr->nc.rank_intra == 0) {
 606             /* Sum with the buffers reversed */
 607             MPI_Allreduce(cr->mpb->libuf,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 608                           cr->nc.comm_inter);
 609         }
 610         MPI_Bcast(r,nr,GMX_MPI_LARGE_INT,0,cr->nc.comm_intra);
 611     } else {
 612         MPI_Allreduce(r,cr->mpb->libuf,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 613                       cr->mpi_comm_mygroup);
 614         for(i=0; i<nr; i++)
 615             r[i] = cr->mpb->libuf[i];
 616     }
 617 #endif
 618 #endif
 619 }
 620
 621
 622
 623 #ifdef GMX_MPI
 624 void gmx_sumd_comm(int nr,double r[],MPI_Comm mpi_comm)
 625 {
 626 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 627     MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_DOUBLE,MPI_SUM,mpi_comm);
 628 #else
 629     /* this function is only used in code that is not performance critical,
 630        (during setup, when comm_rec is not the appropriate communication
 631        structure), so this isn't as bad as it looks. */
 632     double *buf;
 633     int i;
 634
 635     snew(buf, nr);
 636     MPI_Allreduce(r,buf,nr,MPI_DOUBLE,MPI_SUM,mpi_comm);
 637     for(i=0; i<nr; i++)
 638         r[i] = buf[i];
 639     sfree(buf);
 640 #endif
 641 }
 642 #endif
 643
 644 #ifdef GMX_MPI
 645 void gmx_sumf_comm(int nr,float r[],MPI_Comm mpi_comm)
 646 {
 647 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 648     MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_FLOAT,MPI_SUM,mpi_comm);
 649 #else
 650     /* this function is only used in code that is not performance critical,
 651        (during setup, when comm_rec is not the appropriate communication
 652        structure), so this isn't as bad as it looks. */
 653     float *buf;
 654     int i;
 655
 656     snew(buf, nr);
 657     MPI_Allreduce(r,buf,nr,MPI_FLOAT,MPI_SUM,mpi_comm);
 658     for(i=0; i<nr; i++)
 659         r[i] = buf[i];
 660     sfree(buf);
 661 #endif
 662 }
 663 #endif
 664
 665 void gmx_sumd_sim(int nr,double r[],const gmx_multisim_t *ms)
 666 {
 667 #ifndef GMX_MPI
 668   gmx_call("gmx_sumd_sim");
 669 #else
 670   gmx_sumd_comm(nr,r,ms->mpi_comm_masters);
 671 #endif
 672 }
 673
 674 void gmx_sumf_sim(int nr,float r[],const gmx_multisim_t *ms)
 675 {
 676 #ifndef GMX_MPI
 677   gmx_call("gmx_sumf_sim");
 678 #else
 679   gmx_sumf_comm(nr,r,ms->mpi_comm_masters);
 680 #endif
 681 }
 682
 683 void gmx_sumi_sim(int nr,int r[], const gmx_multisim_t *ms)
 684 {
 685 #ifndef GMX_MPI
 686     gmx_call("gmx_sumi_sim");
 687 #else
 688 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 689     MPI_Allreduce(MPI_IN_PLACE,r,nr,MPI_INT,MPI_SUM,ms->mpi_comm_masters);
 690 #else
 691     /* this is thread-unsafe, but it will do for now: */
 692     int i;
 693
 694     if (nr > ms->mpb->ibuf_alloc) {
 695         ms->mpb->ibuf_alloc = nr;
 696         srenew(ms->mpb->ibuf,ms->mpb->ibuf_alloc);
 697     }
 698     MPI_Allreduce(r,ms->mpb->ibuf,nr,MPI_INT,MPI_SUM,ms->mpi_comm_masters);
 699     for(i=0; i<nr; i++)
 700         r[i] = ms->mpb->ibuf[i];
 701 #endif
 702 #endif
 703 }
 704
 705 void gmx_sumli_sim(int nr,gmx_large_int_t r[], const gmx_multisim_t *ms)
 706 {
 707 #ifndef GMX_MPI
 708     gmx_call("gmx_sumli_sim");
 709 #else
 710 #if defined(MPI_IN_PLACE_EXISTS) || defined(GMX_THREAD_MPI)
 711     MPI_Allreduce(MPI_IN_PLACE,r,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 712                   ms->mpi_comm_masters);
 713 #else
 714     /* this is thread-unsafe, but it will do for now: */
 715     int i;
 716
 717     if (nr > ms->mpb->libuf_alloc) {
 718         ms->mpb->libuf_alloc = nr;
 719         srenew(ms->mpb->libuf,ms->mpb->libuf_alloc);
 720     }
 721     MPI_Allreduce(r,ms->mpb->libuf,nr,GMX_MPI_LARGE_INT,MPI_SUM,
 722                   ms->mpi_comm_masters);
 723     for(i=0; i<nr; i++)
 724         r[i] = ms->mpb->libuf[i];
 725 #endif
 726 #endif
 727 }
 728
 729
 730 void gmx_finalize_par(void)
 731 {
 732 #ifndef GMX_MPI
 733     /* Compiled without MPI, no MPI finalizing needed */
 734     return;
 735 #else
 736     int initialized,finalized;
 737     int ret;
 738
 739     MPI_Initialized(&initialized);
 740     if (!initialized)
 741     {
 742         return;
 743     }
 744     /* just as a check; we don't want to finalize twice */
 745     MPI_Finalized(&finalized);
 746     if (finalized)
 747     {
 748         return;
 749     }
 750
 751   /* We sync the processes here to try to avoid problems
 752    * with buggy MPI implementations that could cause
 753    * unfinished processes to terminate.
 754    */
 755   MPI_Barrier(MPI_COMM_WORLD);
 756
 757   /*
 758   if (DOMAINDECOMP(cr)) {
 759     if (cr->npmenodes > 0 || cr->dd->bCartesian)
 760       MPI_Comm_free(&cr->mpi_comm_mygroup);
 761     if (cr->dd->bCartesian)
 762       MPI_Comm_free(&cr->mpi_comm_mysim);
 763   }
 764   */
 765
 766   /* Apparently certain mpich implementations cause problems
 767    * with MPI_Finalize. In that case comment out MPI_Finalize.
 768    */
 769   if (debug)
 770     fprintf(debug,"Will call MPI_Finalize now\n");
 771
 772   ret = MPI_Finalize();
 773   if (debug)
 774     fprintf(debug,"Return code from MPI_Finalize = %d\n",ret);
 775 #endif
 776 }
 777