int tMPI_Cart_get(tMPI_Comm comm, int maxdims, int *dims, int *periods, int *coords) { int i; int myrank=tMPI_Comm_seek_rank(comm, tMPI_Get_current()); #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cart_get(%p, %d, %p, %p, %p)", comm, maxdims, dims, periods, coords); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (!comm->cart || comm->cart->ndims==0) return TMPI_SUCCESS; tMPI_Cart_coords(comm, myrank, maxdims, coords); for(i=0;i<comm->cart->ndims;i++) { if (i>=maxdims) { return tMPI_Error(comm, TMPI_ERR_DIMS); } dims[i]=comm->cart->dims[i]; periods[i]=comm->cart->periods[i]; } return TMPI_SUCCESS; }
int tMPI_Barrier(tMPI_Comm comm) { #ifdef TMPI_PROFILE struct tmpi_thread *cur=tMPI_Get_current(); tMPI_Profile_count_start(cur); #endif #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Barrier(%p, %d, %p, %d, %d, %p, %p)", comm); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (comm->grp.N>1) { #if defined(TMPI_PROFILE) tMPI_Profile_wait_start(cur); #endif tMPI_Barrier_wait( &(comm->barrier) ); #if defined(TMPI_PROFILE) tMPI_Profile_wait_stop(cur, TMPIWAIT_Barrier); #endif } #ifdef TMPI_PROFILE tMPI_Profile_count_stop(cur, TMPIFN_Barrier); #endif return TMPI_SUCCESS; }
/* TODO: there must be better ways to do this */ double tMPI_Wtime(void) { double ret=0; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Wtime()"); #endif #if ! (defined( _WIN32 ) || defined( _WIN64 ) ) { struct timeval tv; long int secdiff; int usecdiff; gettimeofday(&tv, NULL); secdiff = tv.tv_sec - tmpi_global->timer_init.tv_sec; usecdiff = tv.tv_usec - tmpi_global->timer_init.tv_usec; ret=(double)secdiff + 1e-6*usecdiff; } #else { DWORD tv=GetTickCount(); /* the windows absolute time GetTickCount() wraps around in ~49 days, so it's safer to always use differences, and assume that our program doesn't run that long.. */ ret=1e-3*((unsigned int)(tv - tmpi_global->timer_init)); } #endif return ret; }
static void* tMPI_Thread_starter(void *arg) { struct tmpi_thread *th = (struct tmpi_thread*)arg; #ifdef TMPI_TRACE tMPI_Trace_print("Created thread nr. %d", (int)(th-threads)); #endif tMPI_Thread_init(th); /* start_fn, start_arg, argc and argv were set by the calling function */ if (!th->start_fn) { th->start_fn_main(th->argc, th->argv); } else { th->start_fn(th->start_arg); if (!tmpi_finalized) { tMPI_Finalize(); } } return 0; }
int tMPI_Comm_rank(tMPI_Comm comm, int *rank) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_rank(%p, %p)", comm, rank); #endif return tMPI_Group_rank(&(comm->grp), rank); }
int tMPI_Comm_size(tMPI_Comm comm, int *size) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_size(%p, %p)", comm, size); #endif return tMPI_Group_size(&(comm->grp), size); }
int tMPI_Cart_coords(tMPI_Comm comm, int rank, int maxdims, int *coords) { int i; int rank_left=rank; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cart_coords(%p, %d, %d, %p)", comm, rank, maxdims, coords); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (!comm->cart || comm->cart->ndims==0) return TMPI_SUCCESS; if (maxdims < comm->cart->ndims) { return tMPI_Error(comm, TMPI_ERR_DIMS); } /* again, row-major ordering */ for(i=comm->cart->ndims-1;i>=0;i--) { coords[i]=rank_left%comm->cart->dims[i]; rank_left /= comm->cart->dims[i]; } return TMPI_SUCCESS; }
int tMPI_Finalized(int *flag) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Finalized(%p)", flag); #endif *flag=tmpi_finalized; return TMPI_SUCCESS; }
int tMPI_Errhandler_free(tMPI_Errhandler *errhandler) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Errhandler_free(%p)", errhandler); #endif free(*errhandler); return TMPI_SUCCESS; }
int tMPI_Comm_get_errhandler(tMPI_Comm comm, tMPI_Errhandler *errhandler) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_get_errhandler(%p, %p)", comm, errhandler); #endif *errhandler=comm->erh; return TMPI_SUCCESS; }
int tMPI_Cart_sub(tMPI_Comm comm, int *remain_dims, tMPI_Comm *newcomm) { int myrank; int ndims=0; int *dims=NULL; int *periods=NULL; int *oldcoords=NULL; int i; int ndims_notused=1; int color_notused=0; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cart_sub(%p, %p, %p)", comm, remain_dims, newcomm); #endif tMPI_Comm_rank(comm, &myrank); if ( comm->cart ) { oldcoords=(int*)tMPI_Malloc(sizeof(int)*comm->cart->ndims); dims=(int*)tMPI_Malloc(sizeof(int)*comm->cart->ndims); periods=(int*)tMPI_Malloc(sizeof(int)*comm->cart->ndims); /* get old coordinates */ tMPI_Cart_coords(comm, myrank, comm->cart->ndims, oldcoords); for(i=0;i<comm->cart->ndims;i++) { if (remain_dims[i]) { /* for the remaining dimensions, copy dimensionality data */ dims[ndims]=comm->cart->dims[i]; periods[ndims]=comm->cart->periods[i]; ndims++; } else { /* base color on not used coordinates. We keep a ndims_notused index multiplier.*/ color_notused += oldcoords[i]*ndims_notused; ndims_notused *= comm->cart->dims[i]; } } } /* key=myrank, because we want the order to remain the same */ tMPI_Comm_split(comm, color_notused, myrank, newcomm); tMPI_Cart_init(newcomm, ndims, dims, periods); if (oldcoords) free(oldcoords); if (dims) free(dims); if (periods) free(periods); return TMPI_SUCCESS; }
int tMPI_Initialized(int *flag) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Initialized(%p)", flag); #endif *flag=(TMPI_COMM_WORLD && !tmpi_finalized); return TMPI_SUCCESS; }
int tMPI_Comm_dup(tMPI_Comm comm, tMPI_Comm *newcomm) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_dup(%p, %p)", comm, newcomm); #endif /* we just call Comm_split because it already contains all the neccesary synchronization constructs. */ return tMPI_Comm_split(comm, 0, tMPI_Comm_seek_rank(comm, tMPI_Get_current()), newcomm); }
/* communicator query&manipulation functions */ int tMPI_Comm_N(tMPI_Comm comm) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_N(%p)", comm); #endif if (!comm) { return 0; } return comm->grp.N; }
int tMPI_Cart_create(tMPI_Comm comm_old, int ndims, int *dims, int *periods, int reorder, tMPI_Comm *comm_cart) { int myrank = tMPI_Comm_seek_rank(comm_old, tMPI_Get_current()); int key = myrank; int color = 0; int Ntot = 1; int i; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cart_create(%p, %d, %p, %p, %d, %p)", comm_old, ndims, dims, periods, reorder, comm_cart); #endif if (!comm_old) { return tMPI_Error(comm_old, TMPI_ERR_COMM); } /* calculate the total number of procs in cartesian comm */ for (i = 0; i < ndims; i++) { Ntot *= dims[i]; } /* refuse to create if there's not enough procs */ if (comm_old->grp.N < Ntot) { *comm_cart = TMPI_COMM_NULL; #if 1 return tMPI_Error(comm_old, TMPI_ERR_CART_CREATE_NPROCS); #endif } if (key >= Ntot) { key = TMPI_UNDEFINED; } if (reorder) { tMPI_Cart_map(comm_old, ndims, dims, periods, &key); } if (key == TMPI_UNDEFINED) { color = TMPI_UNDEFINED; } tMPI_Comm_split(comm_old, color, key, comm_cart); tMPI_Cart_init(comm_cart, ndims, dims, periods); return TMPI_SUCCESS; }
int tMPI_Get_processor_name(char *name, int *resultlen) { int nr=tMPI_Threadnr(tMPI_Get_current()); unsigned int digits=0; const unsigned int base=10; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Get_processor_name(%p, %p)", name, resultlen); #endif /* we don't want to call sprintf here (it turns out to be not entirely thread-safe on Mac OS X, for example), so we do it our own way: */ /* first determine number of digits */ { int rest=nr; while(rest > 0) { rest /= base; digits++; } if (digits==0) digits=1; } #if ! (defined( _WIN32 ) || defined( _WIN64 ) ) strcpy(name, "thread #"); #else strncpy_s(name, TMPI_MAX_PROCESSOR_NAME, "thread #", TMPI_MAX_PROCESSOR_NAME); #endif /* now construct the number */ { size_t len=strlen(name); unsigned int i; int rest=nr; for(i=0;i<digits;i++) { size_t pos=len + (digits-i-1); if (pos < (TMPI_MAX_PROCESSOR_NAME -1) ) name[ pos ]=(char)('0' + rest%base); rest /= base; } if ( (digits+len) < TMPI_MAX_PROCESSOR_NAME) name[digits + len]='\0'; else name[TMPI_MAX_PROCESSOR_NAME]='\0'; } if (resultlen) *resultlen=(int)strlen(name); /* For some reason the MPI standard uses ints instead of size_ts for sizes. */ return TMPI_SUCCESS; }
int tMPI_Get_count(tMPI_Status *status, tMPI_Datatype datatype, int *count) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Get_count(%p, %p, %p)", status, datatype, count); #endif if (!status) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_STATUS); } *count = (int)(status->transferred/datatype->size); return TMPI_SUCCESS; }
int tMPI_Comm_compare(tMPI_Comm comm1, tMPI_Comm comm2, int *result) { int i, j; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_compare(%p, %p, %p)", comm1, comm2, result); #endif if (comm1 == comm2) { *result = TMPI_IDENT; return TMPI_SUCCESS; } if ( (!comm1) || (!comm2) ) { *result = TMPI_UNEQUAL; return TMPI_SUCCESS; } if (comm1->grp.N != comm2->grp.N) { *result = TMPI_UNEQUAL; return TMPI_SUCCESS; } *result = TMPI_CONGRUENT; /* we assume that there are two identical comm members within a comm */ for (i = 0; i < comm1->grp.N; i++) { if (comm1->grp.peers[i] != comm2->grp.peers[i]) { tmpi_bool found = FALSE; *result = TMPI_SIMILAR; for (j = 0; j < comm2->grp.N; j++) { if (comm1->grp.peers[i] == comm2->grp.peers[j]) { found = TRUE; break; } } if (!found) { *result = TMPI_UNEQUAL; return TMPI_SUCCESS; } } } return TMPI_SUCCESS; }
int tMPI_Comm_create(tMPI_Comm comm, tMPI_Group group, tMPI_Comm *newcomm) { int color = TMPI_UNDEFINED; int key = tMPI_Comm_seek_rank(comm, tMPI_Get_current()); #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_create(%p, %p, %p)", comm, group, newcomm); #endif if (tMPI_In_group(group)) { color = 1; } /* the MPI specs specifically say that this is equivalent */ return tMPI_Comm_split(comm, color, key, newcomm); }
int tMPI_Abort(tMPI_Comm comm, int errorcode) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Abort(%p, %d)", comm, errorcode); #endif #if 0 /* we abort(). This way we can run a debugger on it */ fprintf(stderr, "tMPI_Abort called with error code %d", errorcode); if (comm == TMPI_COMM_WORLD) { fprintf(stderr, " on TMPI_COMM_WORLD"); } fprintf(stderr, "\n"); fflush(stdout); abort(); #else /* we just kill all threads, but not the main process */ if (tMPI_Is_master()) { if (comm == TMPI_COMM_WORLD) { fprintf(stderr, "tMPI_Abort called on TMPI_COMM_WORLD main with errorcode=%d\n", errorcode); } else { fprintf(stderr, "tMPI_Abort called on main thread with errorcode=%d\n", errorcode); } fflush(stderr); exit(errorcode); } else { int *ret; /* kill myself */ fprintf(stderr, "tMPI_Abort called with error code %d on thread %d\n", errorcode, tMPI_This_threadnr()); fflush(stderr); ret = (int*)malloc(sizeof(int)); tMPI_Thread_exit(ret); } #endif return TMPI_SUCCESS; }
int tMPI_Cartdim_get(tMPI_Comm comm, int *ndims) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cartdim_get(%p, %p)", comm, ndims); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (!comm->cart || comm->cart->ndims==0) { return TMPI_SUCCESS; } *ndims=comm->cart->ndims; return TMPI_SUCCESS; }
int tMPI_Type_contiguous(int count, tMPI_Datatype oldtype, tMPI_Datatype *newtype) { struct tmpi_datatype_ *ntp; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Type_contiguous(%d, %p, %p)", count, oldtype, newtype); #endif ntp = (struct tmpi_datatype_*)tMPI_Malloc(sizeof(struct tmpi_datatype_)); ntp->size = count*oldtype->size; ntp->op_functions = NULL; /* establish components */ ntp->N_comp = 1; ntp->comps = (struct tmpi_datatype_component*)tMPI_Malloc( sizeof(struct tmpi_datatype_component)*1); ntp->comps[0].type = oldtype; ntp->comps[0].count = 1; ntp->committed = FALSE; /* now add it to the list. */ tMPI_Spinlock_lock(&(tmpi_global->datatype_lock)); /* check whether there's space */ if (tmpi_global->N_usertypes + 1 >= tmpi_global->Nalloc_usertypes) { /* make space */ tmpi_global->Nalloc_usertypes = Nthreads*(tmpi_global->N_usertypes) + 1; tmpi_global->usertypes = (struct tmpi_datatype_**) tMPI_Realloc(tmpi_global->usertypes, (sizeof(struct tmpi_datatype_ *)* tmpi_global->Nalloc_usertypes) ); } /* add to the list */ tmpi_global->usertypes[tmpi_global->N_usertypes] = ntp; tmpi_global->N_usertypes++; *newtype = ntp; tMPI_Spinlock_unlock(&(tmpi_global->datatype_lock)); return TMPI_SUCCESS; }
int tMPI_Cart_rank(tMPI_Comm comm, int *coords, int *rank) { int i, mul = 1, ret = 0; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cart_get(%p, %p, %p)", comm, coords, rank); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (!comm->cart || comm->cart->ndims == 0) { return TMPI_SUCCESS; } /* because of row-major ordering, we count the dimensions down */ for (i = comm->cart->ndims-1; i >= 0; i--) { int rcoord = coords[i]; if (comm->cart->periods[i]) { /* apply periodic boundary conditions */ rcoord = rcoord % comm->cart->dims[i]; if (rcoord < 0) { rcoord += comm->cart->dims[i]; } } else { if (rcoord < 0 || rcoord >= comm->cart->dims[i]) { return tMPI_Error(comm, TMPI_ERR_DIMS); } } ret += mul*rcoord; mul *= comm->cart->dims[i]; } *rank = ret; return TMPI_SUCCESS; }
int tMPI_Init_fn(int main_thread_returns, int N, void (*start_function)(void*), void *arg) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Init_fn(%d, %p, %p)", N, start_function, arg); #endif if (N<1) { N=tMPI_Thread_get_hw_number(); if (N<1) N=1; /*because that's what the fn returns if it doesn't know*/ } if (TMPI_COMM_WORLD==0 && N>=1) /* we're the main process */ { tMPI_Start_threads(main_thread_returns, N, 0, 0, start_function, arg, NULL); } return TMPI_SUCCESS; }
int tMPI_Create_errhandler(tMPI_Errhandler_fn *function, tMPI_Errhandler *errhandler) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Create_errhandler(%p, %p)", function, errhandler); #endif /* we don't use a special malloc here because this is the error handler creation function. */ *errhandler=(tMPI_Errhandler)malloc(sizeof(struct tmpi_errhandler_)); if (!*errhandler) { fprintf(stderr, "tMPI fatal error (%s), bailing out\n", tmpi_errmsg[TMPI_ERR_MALLOC]); abort(); } (*errhandler)->err=0; (*errhandler)->fn=*function; return TMPI_SUCCESS; }
/* topology functions */ int tMPI_Topo_test(tMPI_Comm comm, int *status) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Topo_test(%p, %p)", comm, status); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (comm->cart) *status=TMPI_CART; /*else if (comm->graph) status=MPI_GRAPH;*/ else *status=TMPI_UNDEFINED; return TMPI_SUCCESS; }
int tMPI_Init(int *argc, char ***argv, int (*start_function)(int, char**)) { #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Init(%p, %p, %p)", argc, argv, start_function); #endif if (TMPI_COMM_WORLD==0) /* we're the main process */ { int N=0; tMPI_Get_N(argc, argv, "-nt", &N); tMPI_Start_threads(FALSE, N, argc, argv, NULL, NULL, start_function); } else { /* if we're a sub-thread we need don't need to do anyhing, because everything has already been set up by either the main thread, or the thread runner function.*/ } return TMPI_SUCCESS; }
int tMPI_Cart_map(tMPI_Comm comm, int ndims, int *dims, int *periods, int *newrank) { /* this function doesn't actually do anything beyond returning the current rank (or TMPI_UNDEFINED if it doesn't fit in the new topology */ int myrank=tMPI_Comm_seek_rank(comm, tMPI_Get_current()); int Ntot=1; int i; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Cart_map(%p, %d, %p, %p, %p)", comm, ndims, dims, periods, newrank); #endif if (!comm) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } if (!periods) { return tMPI_Error(comm, TMPI_ERR_DIMS); } /* calculate the total number of procs in cartesian comm */ for(i=0;i<ndims;i++) { Ntot *= dims[i]; } if (myrank >= Ntot) { *newrank=TMPI_UNDEFINED; } else { *newrank=myrank; } return TMPI_SUCCESS; }
int tMPI_Scan(void* sendbuf, void* recvbuf, int count, tMPI_Datatype datatype, tMPI_Op op, tMPI_Comm comm) { struct tmpi_thread *cur=tMPI_Get_current(); int myrank=tMPI_Comm_seek_rank(comm, cur); int N=tMPI_Comm_N(comm); int prev=myrank - 1; /* my previous neighbor */ int next=myrank + 1; /* my next neighbor */ #ifdef TMPI_PROFILE tMPI_Profile_count_start(cur); #endif #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Scan(%p, %p, %d, %p, %p, %p)", sendbuf, recvbuf, count, datatype, op, comm); #endif if (count==0) return TMPI_SUCCESS; if (!recvbuf) { return tMPI_Error(comm, TMPI_ERR_BUF); } if (sendbuf==TMPI_IN_PLACE) { sendbuf=recvbuf; } /* we set our send and recv buffers */ tMPI_Atomic_ptr_set(&(comm->reduce_sendbuf[myrank]),sendbuf); tMPI_Atomic_ptr_set(&(comm->reduce_recvbuf[myrank]),recvbuf); /* now wait for the previous rank to finish */ if (myrank > 0) { void *a, *b; int ret; #if defined(TMPI_PROFILE) && defined(TMPI_CYCLE_COUNT) tMPI_Profile_wait_start(cur); #endif /* wait for the previous neighbor's data to be ready */ tMPI_Event_wait( &(comm->csync[myrank].events[prev]) ); tMPI_Event_process( &(comm->csync[myrank].events[prev]), 1); #if defined(TMPI_PROFILE) && defined(TMPI_CYCLE_COUNT) tMPI_Profile_wait_stop(cur, TMPIWAIT_Reduce); #endif #ifdef TMPI_DEBUG printf("%d: scanning with %d \n", myrank, prev, iteration); fflush(stdout); #endif /* now do the reduction */ if (prev > 0) { a = (void*)tMPI_Atomic_ptr_get(&(comm->reduce_recvbuf[prev])); } else { a = (void*)tMPI_Atomic_ptr_get(&(comm->reduce_sendbuf[prev])); } b = sendbuf; if ((ret=tMPI_Reduce_run_op(recvbuf, a, b, datatype, count, op, comm)) != TMPI_SUCCESS) { return ret; } /* signal to my previous neighbor that I'm done with the data */ tMPI_Event_signal( &(comm->csync[prev].events[prev]) ); } else { if (sendbuf != recvbuf) { /* copy the data if this is rank 0, and not MPI_IN_PLACE */ memcpy(recvbuf, sendbuf, count*datatype->size); } } if (myrank < N-1) { /* signal to my next neighbor that I have the data */ tMPI_Event_signal( &(comm->csync[next].events[myrank]) ); /* and wait for my next neighbor to finish */ tMPI_Event_wait( &(comm->csync[myrank].events[myrank]) ); tMPI_Event_process( &(comm->csync[myrank].events[myrank]), 1); } #if defined(TMPI_PROFILE) && defined(TMPI_CYCLE_COUNT) tMPI_Profile_wait_start(cur); #endif /*tMPI_Barrier_wait( &(comm->barrier));*/ #if defined(TMPI_PROFILE) /*tMPI_Profile_wait_stop(cur, TMPIWAIT_Reduce);*/ tMPI_Profile_count_stop(cur, TMPIFN_Scan); #endif return TMPI_SUCCESS; }
/* this is the main comm creation function. All other functions that create comms use this*/ int tMPI_Comm_split(tMPI_Comm comm, int color, int key, tMPI_Comm *newcomm) { int i, j; int N = tMPI_Comm_N(comm); volatile tMPI_Comm *newcomm_list; volatile int colors[MAX_PREALLOC_THREADS]; /* array with the colors of each thread */ volatile int keys[MAX_PREALLOC_THREADS]; /* same for keys (only one of the threads actually suplies these arrays to the comm structure) */ tmpi_bool i_am_first = FALSE; int myrank = tMPI_Comm_seek_rank(comm, tMPI_Get_current()); struct tmpi_split *spl; int ret; #ifdef TMPI_TRACE tMPI_Trace_print("tMPI_Comm_split(%p, %d, %d, %p)", comm, color, key, newcomm); #endif if (!comm) { *newcomm = NULL; return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_COMM); } ret = tMPI_Thread_mutex_lock(&(comm->comm_create_lock)); if (ret != 0) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO); } /* first get the colors */ if (!comm->new_comm) { /* i am apparently first */ comm->split = (struct tmpi_split*)tMPI_Malloc(sizeof(struct tmpi_split)); comm->new_comm = (tMPI_Comm*)tMPI_Malloc(N*sizeof(tMPI_Comm)); if (N <= MAX_PREALLOC_THREADS) { comm->split->colors = colors; comm->split->keys = keys; } else { comm->split->colors = (int*)tMPI_Malloc(N*sizeof(int)); comm->split->keys = (int*)tMPI_Malloc(N*sizeof(int)); } comm->split->Ncol_init = tMPI_Comm_N(comm); comm->split->can_finish = FALSE; i_am_first = TRUE; /* the main communicator contains a list the size of grp.N */ } newcomm_list = comm->new_comm; /* we copy it to the local stacks because we can later erase comm->new_comm safely */ spl = comm->split; /* we do the same for spl */ spl->colors[myrank] = color; spl->keys[myrank] = key; spl->Ncol_init--; if (spl->Ncol_init == 0) { ret = tMPI_Thread_cond_signal(&(comm->comm_create_prep)); if (ret != 0) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO); } } if (!i_am_first) { /* all other threads can just wait until the creator thread is finished */ while (!spl->can_finish) { ret = tMPI_Thread_cond_wait(&(comm->comm_create_finish), &(comm->comm_create_lock) ); if (ret != 0) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO); } } } else { int Ncomms = 0; int comm_color_[MAX_PREALLOC_THREADS]; int comm_N_[MAX_PREALLOC_THREADS]; int *comm_color = comm_color_; /* there can't be more comms than N*/ int *comm_N = comm_N_; /* the number of procs in a group */ int *comm_groups; /* the groups */ tMPI_Comm *comms; /* the communicators */ /* wait for the colors to be done */ /*if (N>1)*/ while (spl->Ncol_init > 0) { ret = tMPI_Thread_cond_wait(&(comm->comm_create_prep), &(comm->comm_create_lock)); if (ret != 0) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO); } } /* reset the state so that a new comm creating function can run */ spl->Ncol_destroy = N; comm->new_comm = 0; comm->split = 0; comm_groups = (int*)tMPI_Malloc(N*N*sizeof(int)); if (N > MAX_PREALLOC_THREADS) { comm_color = (int*)tMPI_Malloc(N*sizeof(int)); comm_N = (int*)tMPI_Malloc(N*sizeof(int)); } /* count colors, allocate and split up communicators */ tMPI_Split_colors(N, (int*)spl->colors, (int*)spl->keys, &Ncomms, comm_N, comm_color, comm_groups); /* allocate a bunch of communicators */ comms = (tMPI_Comm*)tMPI_Malloc(Ncomms*sizeof(tMPI_Comm)); for (i = 0; i < Ncomms; i++) { ret = tMPI_Comm_alloc(&(comms[i]), comm, comm_N[i]); if (ret != TMPI_SUCCESS) { return ret; } } /* now distribute the comms */ for (i = 0; i < Ncomms; i++) { comms[i]->grp.N = comm_N[i]; for (j = 0; j < comm_N[i]; j++) { comms[i]->grp.peers[j] = comm->grp.peers[comm_groups[i*comm->grp.N + j]]; } } /* and put them into the newcomm_list */ for (i = 0; i < N; i++) { newcomm_list[i] = TMPI_COMM_NULL; for (j = 0; j < Ncomms; j++) { if (spl->colors[i] == comm_color[j]) { newcomm_list[i] = comms[j]; break; } } } #ifdef TMPI_DEBUG /* output */ for (i = 0; i < Ncomms; i++) { printf("Group %d (color %d) has %d members: ", i, comm_color[i], comm_N[i]); for (j = 0; j < comm_N[i]; j++) { printf(" %d ", comm_groups[comm->grp.N*i + j]); } printf(" rank: "); for (j = 0; j < comm_N[i]; j++) { printf(" %d ", spl->keys[comm_groups[N*i + j]]); } printf(" color: "); for (j = 0; j < comm_N[i]; j++) { printf(" %d ", spl->colors[comm_groups[N*i + j]]); } printf("\n"); } #endif if (N > MAX_PREALLOC_THREADS) { free((int*)spl->colors); free((int*)spl->keys); free(comm_color); free(comm_N); } free(comm_groups); free(comms); spl->can_finish = TRUE; /* tell the waiting threads that there's a comm ready */ ret = tMPI_Thread_cond_broadcast(&(comm->comm_create_finish)); if (ret != 0) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO); } } /* here the individual threads get their comm object */ *newcomm = newcomm_list[myrank]; /* free when we have assigned them all, so we can reuse the object*/ spl->Ncol_destroy--; if (spl->Ncol_destroy == 0) { free((void*)newcomm_list); free(spl); } ret = tMPI_Thread_mutex_unlock(&(comm->comm_create_lock)); if (ret != 0) { return tMPI_Error(TMPI_COMM_WORLD, TMPI_ERR_IO); } return TMPI_SUCCESS; }