/*
 *
 * Copyright 1998-1999, University of Notre Dame.
 * Authors: Jeffrey M. Squyres, Kinis L. Meyer with M. D. McNally 
 *          and Andrew Lumsdaine
 *
 * This file is part of the Notre Dame LAM implementation of MPI.
 *
 * You should have received a copy of the License Agreement for the
 * Notre Dame LAM implementation of MPI along with the software; see
 * the file LICENSE.  If not, contact Office of Research, University
 * of Notre Dame, Notre Dame, IN 46556.
 *
 * Permission to modify the code and to distribute modified code is
 * granted, provided the text of this NOTICE is retained, a notice that
 * the code was modified is included with the above COPYRIGHT NOTICE and
 * with the COPYRIGHT NOTICE in the LICENSE file, and that the LICENSE
 * file is distributed with the modified code.
 *
 * LICENSOR MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED.
 * By way of example, but not limitation, Licensor MAKES NO
 * REPRESENTATIONS OR WARRANTIES OF MERCHANTABILITY OR FITNESS FOR ANY
 * PARTICULAR PURPOSE OR THAT THE USE OF THE LICENSED SOFTWARE COMPONENTS
 * OR DOCUMENTATION WILL NOT INFRINGE ANY PATENTS, COPYRIGHTS, TRADEMARKS
 * OR OTHER RIGHTS.  
 *
 * Additional copyrights may follow.
 *
 *	Ohio Trollius
 *	Copyright 1996 The Ohio State University
 *	RBD/GDB/NJN
 *
 *	$Id: csplit.c,v 6.3 1999/08/04 21:43:49 kmeyer1 Exp $
 *
 *	Function:	- split communicator into disjoint subsets
 *	Accepts:	- old communicator
 *			- process colour
 *			- process key
 *			- new communicator (out)
 *	Returns:	- MPI_SUCCESS or error code
 */

#include <stdlib.h>

#include <lam_config.h>
#include <blktype.h>
#include <mpi.h>
#include <mpisys.h>
#include <terror.h>

/*
 * external functions
 */
extern int		lam_cubedim();
extern int		lam_tr_comm();

/*
 * local functions
 */
static int		cmpprocs();

int
MPI_Comm_split(comm, colour, key, newcomm)

MPI_Comm		comm;
int			colour;
int			key;
MPI_Comm		*newcomm;

{
	MPI_Group	oldgroup;		/* old group */
	MPI_Group	newgroup;		/* new group */
	int		mycid;			/* my context ID */
	int		cid;			/* global context ID */
	int		i;			/* favourite index */
	int		err;			/* error code */
	int		myrank;			/* my group rank */
	int		nprocs;			/* # processes */
	int		mynprocs;		/* # procs in new comm */
	int		*procs;			/* procs array */
	int		*myprocs;		/* new comm procs array */
	int		*p, *p2;		/* favourite pointers */

	lam_initerr();
	lam_setfunc(BLKMPICOMMSPLIT);
/*
 * Check the arguments.
 */
	if (comm == MPI_COMM_NULL) {
		return(lam_errfunc(MPI_COMM_WORLD, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_COMM, 0)));
	}

	if (LAM_IS_INTER(comm)) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_COMM, 0)));
	}

	if (newcomm == 0) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_ARG, 0)));
	}

#if LAM_WANT_IMPI

	/* Remove this when IMPI collectives are implemented */

        if (LAM_IS_IMPI(comm)) {
	  return lam_err_comm(comm, MPI_ERR_COMM, 0, 
			      "Collectives not yet implemented on IMPI communicators");
	}
#endif

/*
 * Set up tracing.
 */
	LAM_TRACE(lam_tr_cffstart(BLKMPICOMMSPLIT));
/*
 * Create the new context ID using MPI_Allreduce().
 * Processes not in group participate but do not affect the context ID.
 */
	MPI_Comm_rank(comm, &myrank);

	mycid = (myrank == MPI_UNDEFINED) ? 0 : lam_getcid();
	if (mycid < 0) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_INTERN, EFULL)));
	}

	err = MPI_Allreduce(&mycid, &cid, 1, MPI_INT, MPI_MAX, comm);
	if (err != MPI_SUCCESS) {
		LAM_TRACE(lam_tr_cffend(BLKMPICOMMSPLIT, -1, comm, 0, 0));
		lam_resetfunc(BLKMPICOMMSPLIT);
		return(lam_errfunc(comm, BLKMPICOMMSPLIT, err));
	}
/*
 * Create the array of process information.
 */
	MPI_Comm_size(comm, &nprocs);

	procs = (int *) malloc((unsigned) 3 * nprocs * sizeof(int));
	if (procs == 0) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_OTHER, errno)));
	}
/*
 * Gather all process information at all processes.
 */
	p = &procs[3 * myrank];
	p[0] = colour;
	p[1] = key;
	p[2] = myrank;

	err = MPI_Allgather(p, 3, MPI_INT, procs, 3, MPI_INT, comm);
	if (err != MPI_SUCCESS) {
		free((char *) procs);
		LAM_TRACE(lam_tr_cffend(BLKMPICOMMSPLIT, -1, comm, 0, 0));
		lam_resetfunc(BLKMPICOMMSPLIT);
		return(lam_errfunc(comm, BLKMPICOMMSPLIT, err));
	}
/*
 * Processes with undefined colour can stop here.
 */
	if (colour == MPI_UNDEFINED) {
		*newcomm = MPI_COMM_NULL;
		free((char *) procs);
		LAM_TRACE(lam_tr_cffend(BLKMPICOMMSPLIT, -1, comm, 0, 0));
		lam_resetfunc(BLKMPICOMMSPLIT);
		return(MPI_SUCCESS);
	}
/*
 * Sort the process information.
 * Locate and count the # of processes having my colour.
 */
	qsort((char *) procs, nprocs, 3 * sizeof(int), cmpprocs);

	myprocs = 0;

	for (i = 0, p = procs; (i < nprocs) && (*p != colour); ++i, p += 3);

	myprocs = p;
	mynprocs = 1;

	for (++i, p += 3; (i < nprocs) && (*p == colour); ++i, p += 3) {
		++mynprocs;
	}
/*
 * Compact the old ranks of my old group in the array.
 */
	p = myprocs;
	p2 = myprocs + 2;

	for (i = 0; i < mynprocs; ++i, ++p, p2 += 3) {
		*p = *p2;
	}
/*
 * Create the new group.
 */
	MPI_Comm_group(comm, &oldgroup);

	err = MPI_Group_incl(oldgroup, mynprocs, myprocs, &newgroup);
	if (err != MPI_SUCCESS) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT, err));
	}

	free((char *) procs);
	MPI_Group_free(&oldgroup);
/*
 * Create the new communicator.
 * MPI_Comm_create() is not called because we don't want to communicate
 * globally again, we have the new contextid (and the undefined-colour
 * procs have returned), so we win speed and safety.
 */
	*newcomm = 0;
	if (lam_comm_new(cid, newgroup, MPI_GROUP_NULL, 0, newcomm)) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_OTHER, errno)));
	}

	(*newcomm)->c_errhdl = comm->c_errhdl;
	comm->c_errhdl->eh_refcount++;

	if (!al_insert(lam_comms, newcomm)) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_INTERN, errno)));
	}
	
	if (lam_tr_comm(*newcomm)) {
		return(lam_errfunc(comm, BLKMPICOMMSPLIT,
				lam_mkerr(MPI_ERR_INTERN, errno)));
	}

	lam_setcid(cid);

	LAM_TRACE(lam_tr_cffend(BLKMPICOMMSPLIT, -1, comm, 0, 0));

	lam_resetfunc(BLKMPICOMMSPLIT);
	return(MPI_SUCCESS);
}

/*
 *	cmpprocs
 *
 *	Function:	- compare two process entries
 *	Accepts:	- ptr 1st entry
 *			- ptr 2nd entry
 *	Returns:	- -1, 0, +1 (less, equal, greater)
 */
static int
cmpprocs(e1, e2)

int			*e1, *e2;

{
	int		cmp;

	if (*e1 < *e2) {
		cmp = -1;
	} else if (*e1 > *e2) {
		cmp = 1;
	} else if (*(++e1) < *(++e2)) {
		cmp = -1;
	} else if (*e1 > *e2) {
		cmp = 1;
	} else if (*(++e1) < *(++e2)) {
		cmp = -1;
	} else if (*e1 > *e2) {
		cmp = 1;
	} else {
		cmp = 0;
	}

	return(cmp);
}
