1 /* $Id$ */
2 /* computes the number of processes per node a.k.a ppn
3 it is called by every process only once,
4 later calls might not be collective */
5 #include <stdlib.h>
6 #include <stdio.h>
7 #include <string.h>
8 #include <unistd.h>
9 #include <mpi.h>
10 #include "ga.h"
11 #include "ga-mpi.h"
12 #include "typesf2c.h"
13
14 #if defined(__bgq__)
15 #include <process.h>
16 #include <location.h>
17 #include <personality.h>
18 #elif defined(__CRAYXT) || defined(__CRAYXE) || defined(__CRAYXC)
19 #include <pmi.h>
20 #endif
21
util_mpi_check(int rc,char * name)22 static inline int util_mpi_check(int rc, char * name)
23 {
24 if (rc != MPI_SUCCESS) {
25 fprintf(stdout,"util_getppn: %s failed\n",name);
26 return 1;
27 }
28 return 0;
29 }
30
31 static short int ppn_initialized=0;
32 static int ppn=0;
util_getppn_(Integer * ppn_out)33 void FATR util_getppn_(Integer *ppn_out){
34
35 #if defined(__bgq__)
36 *ppn_out = (Integer) Kernel_ProcessCount();
37 return;
38 if(0) {
39 #elif MPI_VERSION >= 3
40
41 int err;
42 MPI_Comm comm_node;
43
44 if(ppn_initialized) {
45 *ppn_out = (Integer) ppn;
46
47 }else{
48 MPI_Comm ga_comm=GA_MPI_Comm_pgroup_default();
49 err = MPI_Comm_split_type(ga_comm, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, &comm_node);
50 if (util_mpi_check(err,"MPI_Comm_split_type")) goto errlab;
51
52 err = MPI_Comm_size(comm_node, &ppn);
53 if (util_mpi_check(err,"MPI_Comm_size")) goto errlab;
54
55 err = MPI_Comm_free(&comm_node);
56 if (util_mpi_check(err,"MPI_Comm_free")) goto errlab;
57
58 ppn_initialized=1;
59 *ppn_out = (Integer) ppn;
60 return;
61 #else // no MPI-3 or machine-specific optimized implementation
62 /* A space-efficient implementation is described in pseudo-code here:
63 * http://lists.mcs.anl.gov/pipermail/mpich-discuss/2012-January/011662.html
64 * A slightly more efficient implementation than below may be:
65 * https://github.com/jeffhammond/HPCInfo/blob/master/mpi/advanced/symmetric-heap.c */
66 const int mxlen = 255;
67 char myhostname[mxlen];
68 char* recvbuf;
69 int i, num_procs, me, err, modppn;
70 MPI_Comm ga_comm=GA_MPI_Comm_pgroup_default();
71
72 if(ppn_initialized) {
73 *ppn_out = (Integer) ppn;
74
75 }else{
76 num_procs = GA_Nnodes();
77 me = GA_Nodeid();
78
79 recvbuf=(char*)malloc(num_procs*(mxlen+1)*(sizeof(char)));
80
81 err=gethostname(myhostname, sizeof(myhostname) );
82 if (err != 0) {
83 fprintf(stdout,"util_getppn: gethostname failed\n");
84 ppn=0;
85 goto errlab;
86 }
87
88
89 err=MPI_Allgather(myhostname, mxlen, MPI_CHAR, recvbuf, mxlen, MPI_CHAR, ga_comm);
90 if (err != MPI_SUCCESS) {
91 fprintf(stdout,"util_getppn: MPI_Allgather failed\n");
92 ppn=0;
93 goto errlab;
94 }
95
96
97 for (i=0; i< num_procs; i++){
98 if(strcmp(myhostname,&recvbuf[mxlen*i])==0) ppn++;
99 }
100
101 /* free malloc'ed memory */
102 free(recvbuf);
103
104
105 /* broadcast ppn to everybody */
106 err= MPI_Bcast(&ppn, 1, MPI_INT, 0, ga_comm);
107 if (err != MPI_SUCCESS) {
108 fprintf(stdout,"util_getppn: MPI_Bcast failed\n");
109 goto errlab;
110 }
111
112
113 /* check that computed ppn is a submultiple of num procs */
114
115 modppn = num_procs%ppn;
116 if (modppn ==0){
117 ppn_initialized=1;
118 *ppn_out = (Integer) ppn;
119 return;
120 }else{
121 printf(" ERROR: numprocs %d ppn %d mod %d\n", num_procs, ppn, modppn);
122 goto errlab;
123 }
124 #endif
125 errlab:
126 GA_Error(" util_getppn failure", 0);
127 return;
128 }
129 }
130
131 /* C binding for util_ppn */
132 int util_cgetppn(){
133 Integer* ppn_out = malloc(sizeof(Integer));
134 int ppn;
135 util_getppn_(ppn_out);
136 ppn = (int ) *ppn_out;
137 free(ppn_out);
138 fflush(stdout);
139 return ppn;
140 }
141
142
143
144 int util_my_smp_index(){
145 int ppn= util_cgetppn();
146 return GA_Nodeid()%ppn;
147 }
148
149 int util_my_smp_master(){
150 int ppn= util_cgetppn();
151 return (GA_Nodeid()/ppn)*ppn;
152 }
153
154