/*
 *
 * 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/JRV
 *
 *	$Id: gather.c,v 6.3 1999/08/04 21:43:49 kmeyer1 Exp $
 *
 *	Function:	- gather buffers at root in process rank order
 *	Accepts:	- send buffer
 *			- send count
 *			- send datatype
 *			- recv buffer
 *			- recv count
 *			- recv datatype
 *			- root
 *			- communicator
 *	Returns:	- MPI_SUCCESS or an MPI error code
 */

#include <lam_config.h>
#include <app_mgmt.h>
#include <blktype.h>
#include <mpi.h>
#include <mpisys.h>
#include <rpisys.h>

int
MPI_Gather(sbuf, scount, sdtype, rbuf, rcount, rdtype, root, comm)

void			*sbuf;
int			scount;
MPI_Datatype		sdtype;
void			*rbuf;
int			rcount;
MPI_Datatype		rdtype;
int			root;
MPI_Comm		comm;

{
	int		i;			/* favourite index */
	int		rank;			/* my rank */
	int		size;			/* group size */
	int		err;			/* error code */
	char		*ptmp;			/* temporary buffer */
	MPI_Aint	incr;			/* increment size */
	MPI_Aint	extent;			/* datatype extent */
	MPI_Status	stat;			/* receive status */
	struct _gps	*p;			/* favourite pointer */

	lam_initerr();
	lam_setfunc(BLKMPIGATHER);
/*
 * Check for invalid arguments.
 */
	if ((comm == MPI_COMM_NULL) || LAM_IS_INTER(comm)) {
		return(lam_errfunc(comm, BLKMPIGATHER,
					lam_mkerr(MPI_ERR_COMM, 0)));
	}

	MPI_Comm_rank(comm, &rank);
	MPI_Comm_size(comm, &size);

	if ((root >= size) || (root < 0)) {
		return(lam_errfunc(comm, BLKMPIGATHER,
					lam_mkerr(MPI_ERR_ROOT, 0)));
	}

	if ((sdtype == MPI_DATATYPE_NULL)
			|| (rank == root && rdtype == MPI_DATATYPE_NULL)) {
		return(lam_errfunc(comm, BLKMPIGATHER,
					lam_mkerr(MPI_ERR_TYPE, 0)));
	}

	if ((scount < 0) || (rank == root && rcount < 0)) {
		return(lam_errfunc(comm, BLKMPIGATHER,
					lam_mkerr(MPI_ERR_COUNT, 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

	LAM_TRACE(lam_tr_cffstart(BLKMPIGATHER));
/*
 * Remember required parameters.
 */
	p = &(comm->c_group->g_procs[root]->p_gps);

	lam_setparam(BLKMPIGATHER, root | (p->gps_grank << 16),
				(p->gps_node << 16) | p->gps_idx);
/*
 * Switch to collective communicator.
 */
	lam_mkcoll(comm);
/*
 * Everyone but root sends data and returns.
 */
	if (rank != root) {

		err = MPI_Send(sbuf, scount, sdtype, root, BLKMPIGATHER, comm);
		lam_mkpt(comm);

		if (err != MPI_SUCCESS) {
			return(lam_errfunc(comm, BLKMPIGATHER, err));
		}

		LAM_TRACE(lam_tr_cffend(BLKMPIGATHER,
						root, comm, sdtype, scount));

		lam_resetfunc(BLKMPIGATHER);
		return(MPI_SUCCESS);
	}
/*
 * I am the root, loop receiving the data.
 */
	MPI_Type_extent(rdtype, &extent);
	incr = extent * rcount;

	for (i = 0, ptmp = (char *) rbuf; i < size; ++i, ptmp += incr) {
/*
 * simple optimization
 */
		if (i == rank) {
			err = lam_dtsndrcv(sbuf, scount, sdtype, ptmp,
					rcount, rdtype, BLKMPIGATHER, comm);
		} else {
			err = MPI_Recv(ptmp, rcount, rdtype, i,
						BLKMPIGATHER, comm, &stat);
		}

		if (err != MPI_SUCCESS) {
			lam_mkpt(comm);
			return(lam_errfunc(comm, BLKMPIGATHER, err));
		}
	}

	lam_mkpt(comm);

	LAM_TRACE(lam_tr_cffend(BLKMPIGATHER, root, comm, sdtype, scount));

	lam_resetfunc(BLKMPIGATHER);
	return(MPI_SUCCESS);
}
