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   if (debug)
 100   {
 101       fprintf(debug,"NNODES=%d, MYRANK=%d, HOSTNAME=%s\n",
 102               mpi_num_nodes,mpi_my_rank,mpi_hostname);
 103   }
 104 #endif
 105
 106   *nnodes=mpi_num_nodes;
 107
 108   return mpi_my_rank;
 109 #endif
 110 }
 111
 112 int  gmx_node_num(void)
 113 {
 114 #ifndef GMX_MPI
 115   return 1;
 116 #else
 117   int i;
 118   (void) MPI_Comm_size(MPI_COMM_WORLD, &i);
 119   return i;
 120 #endif
 121 }
 122
 123 int gmx_node_rank(void)
 124 {
 125 #ifndef GMX_MPI
 126   return 0;
 127 #else
 128   int i;
 129   (void) MPI_Comm_rank(MPI_COMM_WORLD, &i);
 130   return i;
 131 #endif
 132 }
 133
 134
 135 int gmx_hostname_num()
 136 {
 137 #ifndef GMX_MPI
 138   return 0;
 139 #else
 140 #ifdef GMX_THREAD_MPI
 141   /* thread-MPI currently puts the thread number in the process name,
 142    * we might want to change this, as this is inconsistent with what
 143    * most MPI implementations would do when running on a single node.
 144    */
 145   return 0;
 146 #else
 147   int  resultlen,hostnum,i,j;
 148   char mpi_hostname[MPI_MAX_PROCESSOR_NAME],hostnum_str[MPI_MAX_PROCESSOR_NAME];
 149
 150   MPI_Get_processor_name(mpi_hostname,&resultlen);
 151   /* This procedure can only differentiate nodes with host names
 152    * that end on unique numbers.
 153    */
 154   i = 0;
 155   j = 0;
 156   /* Only parse the host name up to the first dot */
 157   while(i < resultlen && mpi_hostname[i] != '.') {
 158     if (isdigit(mpi_hostname[i])) {
 159       hostnum_str[j++] = mpi_hostname[i];
 160     }
 161     i++;
 162   }
 163   hostnum_str[j] = '\0';
 164   if (j == 0) {
 165     hostnum = 0;
 166   } else {
 167     /* Use only the last 9 decimals, so we don't overflow an int */
 168     hostnum = strtol(hostnum_str + max(0,j-9), NULL, 10);
 169   }
 170
 171   if (debug) {
 172     fprintf(debug,"In gmx_setup_nodecomm: hostname '%s', hostnum %d\n",
 173         mpi_hostname,hostnum);
 174   }
 175   return hostnum;
 176 #endif
 177 #endif
 178 }
 179
 180 void gmx_setup_nodecomm(FILE *fplog,t_commrec *cr)
 181 {
 182     gmx_nodecomm_t *nc;
 183     int  n,rank,hostnum,ng,ni;
 184
 185     /* Many MPI implementations do not optimize MPI_Allreduce
 186      * (and probably also other global communication calls)
 187      * for multi-core nodes connected by a network.
 188      * We can optimize such communication by using one MPI call
 189      * within each node and one between the nodes.
 190      * For MVAPICH2 and Intel MPI this reduces the time for
 191      * the global_stat communication by 25%
 192      * for 2x2-core 3 GHz Woodcrest connected by mixed DDR/SDR Infiniband.
 193      * B. Hess, November 2007
 194      */
 195
 196     nc = &cr->nc;
 197
 198     nc->bUse = FALSE;
 199 #ifndef GMX_THREAD_MPI
 200 #ifdef GMX_MPI
 201     MPI_Comm_size(cr->mpi_comm_mygroup,&n);
 202     MPI_Comm_rank(cr->mpi_comm_mygroup,&rank);
 203
 204     hostnum = gmx_hostname_num();
 205
 206     if (debug)
 207     {
 208         fprintf(debug,"In gmx_setup_nodecomm: splitting communicator of size %d\n",n);
 209     }
 210
 211
 212     /* The intra-node communicator, split on node number */
 213     MPI_Comm_split(cr->mpi_comm_mygroup,hostnum,rank,&nc->comm_intra);
 214     MPI_Comm_rank(nc->comm_intra,&nc->rank_intra);
 215     if (debug)
 216     {
 217         fprintf(debug,"In gmx_setup_nodecomm: node rank %d rank_intra %d\n",
 218                 rank,nc->rank_intra);
 219     }
 220     /* The inter-node communicator, split on rank_intra.
 221      * We actually only need the one for rank=0,
 222      * but it is easier to create them all.
 223      */
 224     MPI_Comm_split(cr->mpi_comm_mygroup,nc->rank_intra,rank,&nc->comm_inter);
 225     /* Check if this really created two step communication */
 226     MPI_Comm_size(nc->comm_inter,&ng);
 227     MPI_Comm_size(nc->comm_intra,&ni);
 228     if (debug)
 229     {
 230         fprintf(debug,"In gmx_setup_nodecomm: groups %d, my group size %d\n",
 231                 ng,ni);
 232     }
 233
 234     if (getenv("GMX_NO_NODECOMM") == NULL &&
 235         ((ng > 1 && ng < n) || (ni > 1 && ni < n)))
 236     {
 237         nc->bUse = TRUE;
 238         if (fplog)
 239         {
 240             fprintf(fplog,"Using two step summing over %d groups of on average %.1f processes\n\n",
 241                     ng,(real)n/(real)ng);
 242         }
 243         if (nc->rank_intra > 0)
 244         {
 245             MPI_Comm_free(&nc->comm_inter);
 246         }
 247     }
 248     else
 249     {
 250         /* One group or all processes in a separate group, use normal summing */
 251         MPI_Comm_free(&nc->comm_inter);
 252         MPI_Comm_free(&nc->comm_intra);
 253         if (debug)
 254         {
 255             fprintf(debug,"In gmx_setup_nodecomm: not unsing separate inter- and intra-node communicators.\n");
 256         }
 257     }
 258 #endif
 259 #else
 260     /* tMPI runs only on a single node so just use the nodeid */
 261     nc->rank_intra = cr->nodeid;
 262 #endif
 263 }
 264
 265 void gmx_init_intranode_counters(t_commrec *cr)
 266 {
 267     /* counters for PP+PME and PP-only processes on my physical node */
 268     int nrank_intranode, rank_intranode;
 269     int nrank_pp_intranode, rank_pp_intranode;
 270     /* thread-MPI is not initialized when not running in parallel */
 271 #if defined GMX_MPI && !defined GMX_THREAD_MPI
 272     int nrank_world, rank_world;
 273     int i, mynum, *num, *num_s, *num_pp, *num_pp_s;
 274
 275     MPI_Comm_size(MPI_COMM_WORLD,&nrank_world);
 276     MPI_Comm_rank(MPI_COMM_WORLD,&rank_world);
 277
 278     /* Get the node number from the hostname to identify the nodes */
 279     mynum = gmx_hostname_num();
 280
 281     /* We can't rely on MPI_IN_PLACE, so we need send and receive buffers */
 282     snew(num,   nrank_world);
 283     snew(num_s, nrank_world);
 284     snew(num_pp,   nrank_world);
 285     snew(num_pp_s, nrank_world);
 286
 287     num_s[rank_world]    = mynum;
 288     num_pp_s[rank_world] = (cr->duty & DUTY_PP) ? mynum : -1;
 289
 290     MPI_Allreduce(num_s,    num,    nrank_world, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
 291     MPI_Allreduce(num_pp_s, num_pp, nrank_world, MPI_INT, MPI_SUM, MPI_COMM_WORLD);
 292
 293     nrank_intranode    = 0;
 294     rank_intranode     = 0;
 295     nrank_pp_intranode = 0;
 296     rank_pp_intranode  = 0;
 297     for(i=0; i<nrank_world; i++)
 298     {
 299         if (num[i] == mynum)
 300         {
 301             nrank_intranode++;
 302             if (i < rank_world)
 303             {
 304                 rank_intranode++;
 305             }
 306         }
 307         if ((cr->duty & DUTY_PP) && num_pp[i] == mynum)
 308         {
 309             nrank_pp_intranode++;
 310             if (i < rank_world)
 311             {
 312                 rank_pp_intranode++;
 313             }
 314         }
 315     }
 316     sfree(num);
 317     sfree(num_s);
 318     sfree(num_pp);
 319     sfree(num_pp_s);
 320 #else
 321     /* Serial or thread-MPI code: we run within a single physical node */
 322     nrank_intranode    = cr->nnodes;
 323     rank_intranode     = cr->sim_nodeid;
 324     nrank_pp_intranode = cr->nnodes - cr->npmenodes;
 325     rank_pp_intranode  = cr->nodeid;
 326 #endif
 327
 328     if (debug)
 329     {
 330         char sbuf[STRLEN];
 331         if (cr->duty & DUTY_PP && cr->duty & DUTY_PME)
 332         {
 333             sprintf(sbuf, "PP+PME");
 334         }
 335         else
 336         {
 337             sprintf(sbuf, "%s", cr->duty & DUTY_PP ? "PP" : "PME");
 338         }
 339         fprintf(debug, "On %3s node %d: nrank_intranode=%d, rank_intranode=%d, "
 340                 "nrank_pp_intranode=%d, rank_pp_intranode=%d\n",
 341                 sbuf, cr->sim_nodeid,
 342                 nrank_intranode, rank_intranode,
 343                 nrank_pp_intranode, rank_pp_intranode);
 344     }
 345
 346     cr->nrank_intranode    = nrank_intranode;
 347     cr->rank_intranode     = rank_intranode;
 348     cr->nrank_pp_intranode = nrank_pp_intranode;
 349     cr->rank_pp_intranode  = rank_pp_intranode;
 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