/*
 *
 * 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.
 *
 *
 *	$Id: init.c,v 6.20 1999/09/13 03:40:19 jsquyres Exp $
 *
 *	Function:	- initialize the MPI session
 *			- the kitchen-sink of MPI
 *	Accepts:	- ptr to argc
 *			- ptr to argv
 *	Returns:	- MPI_SUCCESS or error code
 */

#include <errno.h>
#include <stdlib.h>
#include <string.h>

#include <all_list.h>
#include <app_mgmt.h>
#include <blktype.h>
#include <mpi.h>
#include <MPISYSF.h>
#include <mpisys.h>
#include <mpitrace.h>
#include <net.h>
#include <rpisys.h>
#include <terror.h>
#include <typical.h>
#include <t_types.h>
#include <debug.h>
#if LAM_WANT_IMPI
#include <impi.h>
#endif

/*
 * MPISYSF.h undefines the corresponding C constants defined in mpi.h.
 */
#define MPI_C_NULL_COPY_FN		((MPI_Copy_function *) 0)
#define MPI_C_NULL_DELETE_FN		((MPI_Delete_function *) 0)
#define MPI_C_WIN_NULL_COPY_FN		((MPI_Win_copy_attr_function *) 0)
#define MPI_C_WIN_NULL_DELETE_FN	((MPI_Win_delete_attr_function *) 0)

/*
 * private variables
 */
static int		maxtag;			/* max. tag attribute */
static int		host;			/* host rank attribute */
static int		io;			/* I/O rank attribute */
static int		wtimeglob;		/* global time attribute */
static int		mpi_nprocs;		/* # world processes */
static int		mpi_nparent;		/* # parent processes */
static int		mpi_cid;		/* CID of parent intercomm */
static struct _gps	*mpi_procs;		/* array world & parent GPS */
static int              fl_debug = 0;
/*
 * external variables
 */
#if LAM_SIZEOF_LONG_DOUBLE == 16
extern long double	mpi_bottom_[];
extern long double	mpi_argv_null_[];
extern long double	mpi_argvs_null_[];
extern long double	mpi_errcodes_ignore[];
extern long double	mpi_status_ignore[];
extern long double	mpi_statuses_ignore[];
#else
extern double		mpi_bottom_[];
extern double		mpi_argv_null_[];
extern double		mpi_argvs_null_[];
extern double		mpi_errcodes_ignore[];
extern double		mpi_status_ignore[];
extern double		mpi_statuses_ignore[];
#endif

/*
 * exported functions
 */
int			lam_init_comm_world(struct _gps *mpi_procs, 
					    int mpi_nprocs);

/*
 * private functions
 */
static int		init_comm();
static int		init_env();
static int		init_rdtype();
static int		init_f77();
static void		init_dtype();
static void		init_errhdl();
static void		init_op();
static void		make_dtype();
static void		make_op();
static int		comm_cmp(MPI_Comm *a, MPI_Comm *b);
static int		check_cid(MPI_Comm *a, MPI_Comm *b);

/*
 * local structures for maxloc/minloc operations
 */
struct flt_int {
	float		fi_float;
	int		fi_int;
};

struct dbl_int {
	double		di_double;
	int		di_int;
};

struct longdbl_int {
#if LAM_SIZEOF_LONG_DOUBLE
	long double	ldi_double;
#else
	double		ldi_double;
#endif
	int		ldi_int;
};

struct long_int {
	long		li_long;
	int		li_int;
};

struct short_int {
	short		li_short;
	int		li_int;
};

/*
 * Create the whole MPI universe.
 */
int
MPI_Init(pargc, pargv)

int			*pargc;
char			***pargv;

{
	int		fl_init;		/* already init'ed? */
	int		err;			/* return error code */
	int		root;			/* root in parent comm if any */
	char		*name;			/* program name */

	lam_setfunc(BLKMPIINIT);
/*
 * Check if we have been initialized or finalized.
 */
	MPI_Initialized(&fl_init);
	if (fl_init || lam_finalized()) {
		return(lam_errfunc(MPI_COMM_WORLD, BLKMPIINIT,
				lam_mkerr(MPI_ERR_OTHER, EMPIINIT)));
	}
	DBUG("In the mpi_init\n");
/*
 * Initialize LAM.
 */
	name = (pargc && pargv && (*pargc > 0)) ? **pargv : 0;

	if (lam_linit(name, &mpi_nprocs, &mpi_nparent, &mpi_cid,
			&mpi_procs, &root)) {
		terror("MPI_Init: LAM error");
		exit(errno);
	}
/*
 * Initialize MPI pre-defined "stuff".
 * The order below is important, so don't "hack".
 */
	init_errhdl();
	init_dtype();
	init_op();

	if (init_comm()) {
		free((char *) mpi_procs);
		return(lam_errfunc(MPI_COMM_NULL,
			BLKMPIINIT, lam_mkerr(MPI_ERR_OTHER, errno)));
	}
	
#if LAM_WANT_IMPI
	/* Check if it is an IMPI job */

	if (_kio.ki_rtf & RTF_IMPI)
	  if (IMPI_Init(&mpi_nprocs, &mpi_cid, &mpi_procs)) {
		terror("IMPI_Init: LAM error");
		kexit(errno);
	}
#endif
	/* 
	 * Now that MPI_COMM_WORLD has been finalized (haha), we can
	 * put in the trace for it, and the parent (if it exists)
	 */
	if (lam_tr_comm(MPI_COMM_WORLD)) return(LAMERROR);
	if (mpi_nparent > 0)
	  if (lam_tr_comm(lam_comm_parent)) return(LAMERROR);

	if (_kio.ki_rtf & RTF_MPISIGS) {
		if (lam_mpi_set_sighandlers()) {
			return(lam_errfunc(MPI_COMM_NULL,
				BLKMPIINIT, lam_mkerr(MPI_ERR_OTHER, errno)));
		}
	}

	if (init_rdtype() || init_env() || lam_init_onesided() || init_f77()) {
		return(lam_errfunc(MPI_COMM_NULL,
			BLKMPIINIT, lam_mkerr(MPI_ERR_OTHER, errno)));
	}

	lam_ports_init();
/*
 * Initialize profiling package.  */
	MPI_Pcontrol(1);
/*
 * cleanup
 */
	free((char *) mpi_procs);
/*
 * Make sure everyone else has also initialized.  Rank 0 of a spawned
 * world must inform the root parent when this is so.  To make this
 * scheme work nicely with debuggers (and short running child
 * processes), let's also wait for a zero byte ACK from the root of
 * the parent.
 */
#if LAM_WANT_IMPI
	if (LAM_IS_IMPI(MPI_COMM_WORLD)) {
	  DBUG("Calling MPI_Barrier on MPI_COMM_WORLD shadow\n");
	  err = MPI_Barrier(MPI_COMM_WORLD->c_shadow);
	} else {
	  DBUG("Calling MPI_Barrier on MPI_COMM_WORLD\n");
	  err = MPI_Barrier(MPI_COMM_WORLD);
	}
	DBUG("MPI_Init past barrier\n");
#else	
	err = MPI_Barrier(MPI_COMM_WORLD);
#endif
	if (err != MPI_SUCCESS) return(LAMERROR);

	if ((mpi_nparent > 0) && (MPI_COMM_WORLD->c_group->g_myrank == 0)) {
	        MPI_Status status;

		err = MPI_Send((void *) 0, 0, MPI_BYTE,
					root, 0, lam_comm_parent);
		if (err != MPI_SUCCESS) return(LAMERROR);
		err = MPI_Recv((void *) 0, 0, MPI_BYTE,
					root, 0, lam_comm_parent, &status);
		if (err != MPI_SUCCESS) return(LAMERROR);
	}
/*
 * Record an initialization trace.
 * If we are tracing and trace generation is initially to be on, turn it on.
 */
	if (lam_tr_init(name, lam_clockskew)) return(LAMERROR);

	if ((_kio.ki_rtf & RTF_TRON) == RTF_TRON) {
		_kio.ki_rtf &= ~RTF_TRSWITCH;
		if (lam_tr_on() < 0) return(LAMERROR);
	}
	lam_resetfunc(BLKMPIINIT);
	return(MPI_SUCCESS);
}

/*
 *	init_errhdl
 *
 *	Function:	- initialize pre-defined error handles
 */
static void
init_errhdl()

{
	MPI_ERRORS_ARE_FATAL->eh_func = 0;
	MPI_ERRORS_ARE_FATAL->eh_f77handle = -1;
	MPI_ERRORS_ARE_FATAL->eh_refcount = 1;
	MPI_ERRORS_ARE_FATAL->eh_flags = LAM_EHCOMM | LAM_EHWIN | LAM_EHFILE;

	MPI_ERRORS_RETURN->eh_func = (void (*)()) lam_errreturn;
	MPI_ERRORS_RETURN->eh_f77handle = -1;
	MPI_ERRORS_RETURN->eh_refcount = 1;
	MPI_ERRORS_RETURN->eh_flags = LAM_EHCOMM | LAM_EHWIN | LAM_EHFILE;
}

/*
 *	init_comm
 *
 *	Function:	- initialize pre-defined communicators
 *	Returns:	- 0 or LAMERROR
 */
static int
init_comm()

{
	MPI_Group	group;			/* a process group */
	MPI_Comm	comm;			/* a communicator */
	int		i;
	struct _gps	*g;
	struct _proc	**p;
	int             cid;
/*
 * Create the empty group.
 */
	MPI_GROUP_EMPTY->g_nprocs = 0;
	MPI_GROUP_EMPTY->g_myrank = MPI_UNDEFINED;
	MPI_GROUP_EMPTY->g_refcount = 1;
	MPI_GROUP_EMPTY->g_procs = 0;
/*
 * Initialize the list of communicators.
 */
	lam_comms = al_init(sizeof(MPI_Comm), comm_cmp);
	if (lam_comms == 0) return(LAMERROR);
/*
 * Create the "world" communicator.
 */
	if (lam_init_comm_world(mpi_procs, mpi_nprocs) != 0)
	  return (LAMERROR);
/*
 * Set the pid under which run time traces are stored and write the
 * trace for MPI_COMM_WORLD.
 */
	_kio.ki_tid = lam_myproc->p_gps.gps_pid;
/*
 * Create the "self" communicator.
 */
	comm = MPI_COMM_SELF;

	group = (MPI_Group) malloc((unsigned) sizeof(struct _group) +
						sizeof(struct _proc *));
	if (group == 0) return(LAMERROR);

	group->g_nprocs = 1;
	group->g_myrank = 0;
	group->g_refcount = 1;
	group->g_f77handle = -1;
	group->g_procs = (struct _proc **)
				((char *) group + sizeof(struct _group));

	group->g_procs[0] = lam_myproc;
	lam_myproc->p_refcount++;

/*
 * Changed MPI_COMM_SELF's context ID to 2 for IMPI
 * Context ID's are now incremented by 2 so that we can have shadow
 * communicators.
 */
	cid = lam_getcid();
	if (lam_comm_new(cid, group, MPI_GROUP_NULL, LAM_PREDEF, &comm)) {
		return(LAMERROR);
	}
	
	lam_setcid(cid);
	comm->c_errhdl->eh_refcount++;
	strcpy(comm->c_name, "MPI_COMM_SELF");

	if (!al_insert(lam_comms, &comm)) return(LAMERROR);
/*
 * Create the parent intercommunicator if spawned.
 */
	if (mpi_nparent > 0) {

		group = (MPI_Group) malloc((unsigned) sizeof(struct _group) +
					(mpi_nparent * sizeof(struct _proc *)));
		if (group == 0) return(LAMERROR);

		group->g_nprocs = mpi_nparent;
		group->g_myrank = MPI_UNDEFINED;
		group->g_refcount = 1;
		group->g_f77handle = -1;
		group->g_procs = (struct _proc **)
				((char *) group + sizeof(struct _group));
/*
 * Fill the parent group processes.
 */
		g = mpi_procs + mpi_nprocs;
		p = group->g_procs;

		for (i = 0; i < mpi_nparent; ++i, ++g, ++p) {
			*p = lam_procfind(g);
			if (*p == 0) return(LAMERROR);
			(*p)->p_refcount++;
		}

		/* May need to worry about overriding the IMPI min cid
		   here (that was set earlier) -- any IMPI job won't
		   come from a user calling MPI_Spawn, so this
		   couldn't happen. */

		if (lam_comm_new(mpi_cid, MPI_COMM_WORLD->c_group,
				group, LAM_CINTER, &lam_comm_parent)) {
			return(LAMERROR);
		}

		lam_setcid(mpi_cid);
		MPI_COMM_WORLD->c_group->g_refcount++;
		lam_comm_parent->c_errhdl->eh_refcount++;
		strcpy(lam_comm_parent->c_name, "MPI_COMM_PARENT");

		if (!al_insert(lam_comms, &lam_comm_parent)) return(LAMERROR);
	}

	DBUG("Done with init_comm\n");
	return(0);
}

/*
 *	init_comm_world
 *
 *	Function:	- initialize MPI_COMM_WORLD
 */
int
lam_init_comm_world(struct _gps *mpi_procs, int mpi_nprocs)
{
	MPI_Group	group;			/* a process group */
	MPI_Comm	comm;			/* a communicator */
	int		i;
	struct _gps	*g;
	struct _proc	**p;
	int             cid;

	comm = MPI_COMM_WORLD;

	group = (MPI_Group) malloc((unsigned) sizeof(struct _group) +
					(mpi_nprocs * sizeof(struct _proc *)));
	if (group == 0) return(LAMERROR);

	group->g_nprocs = mpi_nprocs;
	DBUG("IN mpi_init, the number of lam procs is %d\n", mpi_nprocs);
	group->g_myrank = MPI_UNDEFINED;
	group->g_refcount = 1;
	group->g_f77handle = -1;
	group->g_procs = (struct _proc **)
				((char *) group + sizeof(struct _group));
/*
 * Fill the group processes and determine my rank.
 */
	g = mpi_procs;
	p = group->g_procs;

	for (i = 0; i < mpi_nprocs; ++i, ++g, ++p) {

		if ((*p = lam_procfind(g)) == 0) {
			return(LAMERROR);
		}
		if (*p == lam_myproc) {
			group->g_myrank = i;
		}
		(*p)->p_refcount++;
	}

	DBUG("Calling lam_comm_new for MPI_COMM_WORLD\n");
	cid = lam_getcid();
	if (lam_comm_new(cid, group, MPI_GROUP_NULL, LAM_PREDEF, &comm))
		return(LAMERROR);

	lam_setcid(cid);
	comm->c_errhdl->eh_refcount++;
	strcpy(comm->c_name, "MPI_COMM_WORLD");

	if (!al_insert(lam_comms, &comm)) return(LAMERROR);

	DBUG("Finished with lam_init_comm_world\n");
	return 0;
}

/*
 *	init_dtype
 *
 *	Function:	- initialize basic (intrinsic) datatypes
 */
static void
init_dtype()

{
/*
 * common datatypes
 */
	make_dtype(MPI_BYTE, sizeof(char), sizeof(char), TRDTBYTE, "MPI_BYTE");
	make_dtype(MPI_PACKED, sizeof(char),
		   sizeof(char), TRDTPACKED, "MPI_PACKED");
	make_dtype(MPI_UB, 0, 1, TRDTUB, "MPI_UB");
	make_dtype(MPI_LB, 0, 1, TRDTLB, "MPI_LB");
/*
 * C datatypes
 */
	make_dtype(MPI_WCHAR, sizeof(wchar_t),
		   sizeof(wchar_t), TRDTWCHAR, "MPI_WCHAR");
	make_dtype(MPI_CHAR, sizeof(char), sizeof(char), TRDTCHAR, "MPI_CHAR");
	make_dtype(MPI_SHORT, sizeof(short),
		   LAM_ALIGNMENT_SHORT, TRDTSHORT, "MPI_SHORT");
	make_dtype(MPI_INT, sizeof(int), LAM_ALIGNMENT_INT, TRDTINT, 
		   "MPI_INT");
	make_dtype(MPI_LONG, sizeof(long),
		   LAM_ALIGNMENT_LONG, TRDTLONG, "MPI_LONG");
	make_dtype(MPI_FLOAT, sizeof(float),
		   LAM_ALIGNMENT_FLOAT, TRDTFLOAT, "MPI_FLOAT");
	make_dtype(MPI_DOUBLE, sizeof(double),
		   LAM_ALIGNMENT_DOUBLE, TRDTDOUBLE, "MPI_DOUBLE");
#if LAM_SIZEOF_LONG_DOUBLE
	make_dtype(MPI_LONG_DOUBLE, sizeof(long double),
		   LAM_ALIGNMENT_LONG_DOUBLE, TRDTLONGDOUBLE, 
		   "MPI_LONG_DOUBLE");
#else
	make_dtype(MPI_LONG_DOUBLE, sizeof(double),
		   LAM_ALIGNMENT_DOUBLE, TRDTLONGDOUBLE, "MPI_LONG_DOUBLE");
#endif
#if LAM_SIZEOF_LONG_LONG
	make_dtype(MPI_LONG_LONG_INT, sizeof(long long),
		   LAM_ALIGNMENT_LONG_LONG, TRDTLONGLONG, "MPI_LONG_LONG_INT");
	make_dtype(MPI_UNSIGNED_LONG_LONG, sizeof(unsigned long long),
		   LAM_ALIGNMENT_LONG_LONG, TRDTULONGLONG, 
		   "MPI_UNSIGNED_LONG_LONG");
#else
	make_dtype(MPI_LONG_LONG_INT, sizeof(long), 
		   LAM_ALIGNMENT_LONG, TRDTLONGLONG, "MPI_LONG_LONG_INT");
	make_dtype(MPI_UNSIGNED_LONG_LONG, sizeof(unsigned long), 
		   LAM_ALIGNMENT_LONG, TRDTULONGLONG, 
		   "MPI_UNSIGNED_LONG_LONG");
#endif
	make_dtype(MPI_UNSIGNED_CHAR, sizeof(unsigned char), 
		   sizeof(unsigned char), TRDTUCHAR, "MPI_UNSIGNED_CHAR");
	make_dtype(MPI_UNSIGNED_SHORT, sizeof(unsigned short), 
		   LAM_ALIGNMENT_SHORT, TRDTUSHORT, "MPI_UNSIGNED_SHORT");
	make_dtype(MPI_UNSIGNED, sizeof(unsigned int), 
		   LAM_ALIGNMENT_INT, TRDTUINT, "MPI_UNSIGNED");
	make_dtype(MPI_UNSIGNED_LONG, sizeof(unsigned long), 
		   LAM_ALIGNMENT_LONG, TRDTULONG, "MPI_UNSIGNED_LONG");
/*
 * FORTRAN datatypes
 */
	make_dtype(MPI_F_CHARACTER, sizeof(char),
		   sizeof(char), TRDTFCHARACTER, "MPI_CHARACTER");
	make_dtype(MPI_F_LOGICAL, sizeof(int),
		   LAM_ALIGNMENT_INT, TRDTFLOGICAL, "MPI_LOGICAL");
	make_dtype(MPI_F_INTEGER, sizeof(int),
		   LAM_ALIGNMENT_INT, TRDTFINTEGER, "MPI_INTEGER");
	make_dtype(MPI_F_REAL, sizeof(float),
		   LAM_ALIGNMENT_FLOAT, TRDTFREAL, "MPI_REAL");
	make_dtype(MPI_F_DOUBLE_PRECISION, sizeof(double),
		   LAM_ALIGNMENT_DOUBLE, TRDTFDBLPREC, "MPI_DOUBLE_PRECISION");
	make_dtype(MPI_F_COMPLEX, 2 * sizeof(float),
		   LAM_ALIGNMENT_FLOAT, TRDTFCOMPLEX, "MPI_COMPLEX");
	make_dtype(MPI_F_DOUBLE_COMPLEX, 2 * sizeof(double),
		   LAM_ALIGNMENT_DOUBLE, TRDTFDBLCOMPLEX, 
		   "MPI_DOUBLE_COMPLEX");
}

/*
 *	init_rdtype
 *
 *	Function:	- initialize the reduction datatypes
 *	Returns:	- 0 or LAMERROR
 */
static int
init_rdtype()

{
	MPI_Datatype	newdtype;		/* new datatype */
	MPI_Datatype	types[2];		/* struct datatypes */
	int		lengths[2];		/* struct lengths */
	MPI_Aint	disps[2];		/* struct displacements */
	struct flt_int	fi[2];			/* float_int data */
	struct dbl_int	di[2];			/* double_int data */
	struct long_int li[2];			/* long_int data */
	struct short_int
			si[2];			/* short_int data */
	struct longdbl_int
			ldi[2];			/* longdbl_int data */
	int		err;			/* error code */
/*
 * Create MPI_2INT.
 */
	err = MPI_Type_contiguous(2, MPI_INT, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_2INT, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_2INT->dt_label = TRDT2INT;
	MPI_2INT->dt_commit = 1;
	MPI_2INT->dt_flags |= LAM_PREDEF;
	strcpy(MPI_2INT->dt_name, "MPI_2INT");
/*
 * Create MPI_FLOAT_INT.
 */
	types[0] = MPI_FLOAT; types[1] = MPI_INT;
	lengths[0] = 1; lengths[1] = 1;

	MPI_Address(&fi[0], &disps[0]);
	MPI_Address(&(fi[0].fi_int), &disps[1]);

	disps[1] -= disps[0]; disps[0] = 0;

	err = MPI_Type_struct(2, lengths, disps, types, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_FLOAT_INT, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_FLOAT_INT->dt_label = TRDTFLOATINT;
	MPI_FLOAT_INT->dt_commit = 1;
	MPI_FLOAT_INT->dt_flags |= LAM_PREDEF;
	strcpy(MPI_FLOAT_INT->dt_name, "MPI_FLOAT_INT");
/*
 * Create MPI_DOUBLE_INT.
 */
	types[0] = MPI_DOUBLE; types[1] = MPI_INT;
	lengths[0] = 1; lengths[1] = 1;

	MPI_Address(&di[0], &disps[0]);
	MPI_Address(&(di[0].di_int), &disps[1]);

	disps[1] -= disps[0]; disps[0] = 0;

	err = MPI_Type_struct(2, lengths, disps, types, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_DOUBLE_INT, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_DOUBLE_INT->dt_label = TRDTDOUBLEINT;
	MPI_DOUBLE_INT->dt_commit = 1;
	MPI_DOUBLE_INT->dt_flags |= LAM_PREDEF;
	strcpy(MPI_DOUBLE_INT->dt_name, "MPI_DOUBLE_INT");
/*
 * Create MPI_LONG_DOUBLE_INT.
 */
	types[0] = MPI_LONG_DOUBLE; types[1] = MPI_INT;
	lengths[0] = 1; lengths[1] = 1;

	MPI_Address(&ldi[0], &disps[0]);
	MPI_Address(&(ldi[0].ldi_int), &disps[1]);

	disps[1] -= disps[0]; disps[0] = 0;

	err = MPI_Type_struct(2, lengths, disps, types, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_LONG_DOUBLE_INT,
		(char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_LONG_DOUBLE_INT->dt_label = TRDTLONGDBLINT;
	MPI_LONG_DOUBLE_INT->dt_commit = 1;
	MPI_LONG_DOUBLE_INT->dt_flags |= LAM_PREDEF;
	strcpy(MPI_LONG_DOUBLE_INT->dt_name, "MPI_LONG_DOUBLE_INT");
/*
 * Create MPI_LONG_INT.
 */
	types[0] = MPI_LONG; types[1] = MPI_INT;
	lengths[0] = 1; lengths[1] = 1;

	MPI_Address(&li[0], &disps[0]);
	MPI_Address(&(li[0].li_int), &disps[1]);

	disps[1] -= disps[0]; disps[0] = 0;

	err = MPI_Type_struct(2, lengths, disps, types, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_LONG_INT, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_LONG_INT->dt_label = TRDTLONGINT;
	MPI_LONG_INT->dt_commit = 1;
	MPI_LONG_INT->dt_flags |= LAM_PREDEF;
	strcpy(MPI_LONG_INT->dt_name, "MPI_LONG_INT");
/*
 * Create MPI_SHORT_INT.
 */
	types[0] = MPI_SHORT; types[1] = MPI_INT;
	lengths[0] = 1; lengths[1] = 1;

	MPI_Address(&si[0], &disps[0]);
	MPI_Address(&(si[0].li_int), &disps[1]);

	disps[1] -= disps[0]; disps[0] = 0;

	err = MPI_Type_struct(2, lengths, disps, types, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_SHORT_INT, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_SHORT_INT->dt_label = TRDTSHORTINT;
	MPI_SHORT_INT->dt_commit = 1;
	MPI_SHORT_INT->dt_flags |= LAM_PREDEF;
	strcpy(MPI_SHORT_INT->dt_name, "MPI_SHORT_INT");
/*
 * Create MPI_2INTEGER.
 */
	err = MPI_Type_contiguous(2, MPI_F_INTEGER, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_F_2INTEGER, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_F_2INTEGER->dt_label = TRDTF2INTEGER;
	MPI_F_2INTEGER->dt_commit = 1;
	MPI_F_2INTEGER->dt_flags |= LAM_PREDEF;
	strcpy(MPI_F_2INTEGER->dt_name, "MPI_2INTEGER");
/*
 * Create MPI_2REAL.
 */
	err = MPI_Type_contiguous(2, MPI_F_REAL, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_F_2REAL, (char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_F_2REAL->dt_label = TRDTF2REAL;
	MPI_F_2REAL->dt_commit = 1;
	MPI_F_2REAL->dt_flags |= LAM_PREDEF;
	strcpy(MPI_F_2REAL->dt_name, "MPI_2REAL");
/*
 * Create MPI_2DOUBLE_PRECISION.
 */
	err = MPI_Type_contiguous(2, MPI_F_DOUBLE_PRECISION, &newdtype);
	if (err != MPI_SUCCESS) return(LAMERROR);

	memcpy((char *) MPI_F_2DOUBLE_PRECISION,
			(char *) newdtype, sizeof(struct _dtype));
	free((char *) newdtype);
	MPI_F_2DOUBLE_PRECISION->dt_label = TRDTF2DBLPREC;
	MPI_F_2DOUBLE_PRECISION->dt_commit = 1;
	MPI_F_2DOUBLE_PRECISION->dt_flags |= LAM_PREDEF;
	strcpy(MPI_F_2DOUBLE_PRECISION->dt_name, "MPI_2DOUBLE_PRECISION");

	return(0);
}

/*
 *	init_op
 *
 *	Function:	- initialize intrinsic reduction operations
 */
static void
init_op()

{
	make_op(MPI_MAX, lam_max);
	make_op(MPI_MIN, lam_min);
	make_op(MPI_SUM, lam_sum);
	make_op(MPI_PROD, lam_prod);
	make_op(MPI_LAND, lam_land);
	make_op(MPI_BAND, lam_band);
	make_op(MPI_LOR, lam_lor);
	make_op(MPI_BOR, lam_bor);
	make_op(MPI_LXOR, lam_lxor);
	make_op(MPI_BXOR, lam_bxor);
	make_op(MPI_MAXLOC, lam_maxloc);
	make_op(MPI_MINLOC, lam_minloc);
	make_op(MPI_REPLACE, lam_replace);
}

/*
 *	init_env
 *
 *	Function:	- initialize environment attributes
 *	Returns:	- 0 or LAMERROR
 */
static int
init_env()

{
	MPI_Group	world;			/* world group */
	struct _attrkey *keystate;		/* key state */
	struct _proc	**p;			/* process */
	int		key;			/* attribute key */
	int		err;			/* error code */
	int		i;
/*
 * Create the predefined keys for MPI_COMM_WORLD.
 */
	err = MPI_Comm_create_keyval(MPI_C_NULL_COPY_FN, MPI_C_NULL_DELETE_FN,
				&key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_TAG_UB)) return(LAMERROR);

	err = MPI_Comm_create_keyval(MPI_C_NULL_COPY_FN, MPI_C_NULL_DELETE_FN,
				&key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_HOST)) return(LAMERROR);

	err = MPI_Comm_create_keyval(MPI_C_NULL_COPY_FN, MPI_C_NULL_DELETE_FN,
				&key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_IO)) return(LAMERROR);

	err = MPI_Comm_create_keyval(MPI_C_NULL_COPY_FN, MPI_C_NULL_DELETE_FN,
				&key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_WTIME_IS_GLOBAL)) {
		return(LAMERROR);
	}

	err = MPI_Comm_create_keyval(MPI_C_NULL_COPY_FN, MPI_C_NULL_DELETE_FN,
				&key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_UNIVERSE_SIZE)) {
		return(LAMERROR);
	}

	err = MPI_Comm_create_keyval(MPI_C_NULL_COPY_FN, MPI_C_NULL_DELETE_FN,
				&key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_APPNUM)) {
		return(LAMERROR);
	}
/*
 * Create the predefined keys for windows.
 */
	err = MPI_Win_create_keyval(MPI_C_WIN_NULL_COPY_FN,
				MPI_C_WIN_NULL_DELETE_FN, &key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_WIN_BASE)) return(LAMERROR);

	err = MPI_Win_create_keyval(MPI_C_WIN_NULL_COPY_FN,
				MPI_C_WIN_NULL_DELETE_FN, &key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_WIN_SIZE)) return(LAMERROR);

	err = MPI_Win_create_keyval(MPI_C_WIN_NULL_COPY_FN,
				MPI_C_WIN_NULL_DELETE_FN, &key, (void *) 0);
	if ((err != MPI_SUCCESS) || (key != MPI_WIN_DISP_UNIT)) {
		return(LAMERROR);
	}
/*
 * Initialize the attribute values.
 */
	maxtag = LAM_MAXTAG;
	wtimeglob = 0;
/*
 * We interpret MPI_IO to include the ability to print to a terminal.
 * MPI_IO is set to my rank if I'm on the origin node.
 * Otherwise, it's set to MPI_ANY_SOURCE if all processes are on
 * the origin node, MPI_PROC_NULL if no processes are on the
 * origin node or the lowest ranked process on the origin node.
 */
	world = MPI_COMM_WORLD->c_group;
	p = world->g_procs;

	for (i = 0; i < world->g_nprocs; ++i) {
		if ((*p)->p_gps.gps_node != getorigin()) break;
		p++;
	}

	if (i >= world->g_nprocs) {
		io = MPI_ANY_SOURCE;
	} else if (lam_myproc->p_gps.gps_node == getorigin()) {
		io = world->g_myrank;
	} else {
		p = world->g_procs;

		for (i = 0; i < world->g_nprocs; ++i) {
			if ((*p)->p_gps.gps_node == getorigin()) break;
			p++;
		}

		io = (i >= world->g_nprocs) ? MPI_PROC_NULL : i;
	}
/*
 * MPI_HOST is similarly related to the origin node, except if all
 * processes are on the origin, we set this attribute to rank 0.
 */
	p = world->g_procs;

	for (i = 0; i < world->g_nprocs; ++i) {
		if ((*p)->p_gps.gps_node == getorigin()) break;
		p++;
	}

	host = (i >= world->g_nprocs) ? MPI_PROC_NULL : i;
/*
 * The universe size is inherited from the parents or is the number of
 * nodes in the LAM.
 */
	if (lam_universe_size < 0) {
		if ((lam_universe_size = getnall()) < 0) {
			return(LAMERROR);
		}
	}
/*
 * Store the attribute values.
 */
	err = MPI_Comm_set_attr(MPI_COMM_WORLD, MPI_TAG_UB, (void *) maxtag);
	if (err != MPI_SUCCESS) return(LAMERROR);

	err = MPI_Comm_set_attr(MPI_COMM_WORLD, MPI_HOST, (void *) host);
	if (err != MPI_SUCCESS) return(LAMERROR);

	err = MPI_Comm_set_attr(MPI_COMM_WORLD, MPI_IO, (void *) io);
	if (err != MPI_SUCCESS) return(LAMERROR);

	err = MPI_Comm_set_attr(MPI_COMM_WORLD,
				MPI_WTIME_IS_GLOBAL, (void *) wtimeglob);
	if (err != MPI_SUCCESS) return(LAMERROR);

	err = MPI_Comm_set_attr(MPI_COMM_WORLD,
				MPI_UNIVERSE_SIZE, (void *) lam_universe_size);
	if (err != MPI_SUCCESS) return(LAMERROR);

	if (lam_appnum >= 0) {
		err = MPI_Comm_set_attr(MPI_COMM_WORLD,
					MPI_APPNUM, (void *) lam_appnum);
		if (err != MPI_SUCCESS) return(LAMERROR);
	}
/*
 * Mark them as predefined and mark the style, integer valued is F77 style.
 */
	if ((keystate = lam_getattr(MPI_TAG_UB)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_HOST)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_IO)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_WTIME_IS_GLOBAL)) == 0) {
		return(LAMERROR);
	}
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_UNIVERSE_SIZE)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_APPNUM)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_WIN_BASE)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF;

	if ((keystate = lam_getattr(MPI_WIN_SIZE)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	if ((keystate = lam_getattr(MPI_WIN_DISP_UNIT)) == 0) return(LAMERROR);
	keystate->ak_flags |= LAM_PREDEF | LAM_LANGF77;

	return(0);
}

/*
 *	make_dtype
 *
 *	Function:	- create a basic datatype
 *			- no errors happen here
 *	Accepts:	- MPI datatype
 *			- size of datatype
 *			- datatype label
 *			- datatype name
 */
static void
make_dtype(dtype, size, align, label, name)

MPI_Datatype		dtype;
int			size;
int			align;
int			label;
char			*name;

{
	lam_type_setdefaults(dtype);

	dtype->dt_format = LAM_DTBASIC;
	dtype->dt_flags = LAM_DTNOPACK | LAM_DTNOXADJ | LAM_PREDEF;
	dtype->dt_commit = 1;
	dtype->dt_label = label;
	dtype->dt_refcount = 1;
	dtype->dt_align = align;
	dtype->dt_upper = size;
	dtype->dt_dataup = size;
	dtype->dt_size = size;
	dtype->dt_nelem = 1;
	strcpy(dtype->dt_name, name);
/*
 * Patch up the weird bound marker types.
 */
	if (dtype == MPI_UB) {
		dtype->dt_flags |= LAM_DTHASUB;
		dtype->dt_nelem = 0;
	}
	else if (dtype == MPI_LB) {
		dtype->dt_flags |= LAM_DTHASLB;
		dtype->dt_nelem = 0;
	}
}

/*
 *	make_op
 *
 *	Function:	- create intrinsic reduction operation
 *			- no errors happen here
 *	Accepts:	- MPI reduction operation
 *			- reduction function
 */
static void
make_op(op, func)

MPI_Op			op;
void			(*func)();

{
	op->op_func = func;
	op->op_commute = 1;
	op->op_f77handle = -1;
	op->op_flags = LAM_PREDEF;
}

/*
 *	comm_cmp
 *
 *	Function:	- compare two communicators
 *	Accepts:	- ptr to two entries
 *	Returns:	- 0 if same communicator, else 1
 */
static int
comm_cmp(c1, c2)

MPI_Comm		*c1, *c2;

{
#if LAM_WANT_IMPI
  if ((*c1)->c_flags & LAM_CFAKE) {
    if ((*c2)->c_flags & LAM_CFAKE)
      if (check_cid(c1, c2) == 0) {
	if (memcmp((*c1)->c_reserved, (*c2)->c_reserved, 
		   sizeof(IMPI_Uint8)) == 0)
	  return 0;
	else
	  return 1;
      } else
	return 1;
    else
      return 1;
  } else if ((*c2)->c_flags & LAM_CFAKE)
    return 1;
  else
#endif
    return check_cid(c1, c2);
}

/*
 *	check_cid
 *
 *	Function:	- compare two communicators by CID only
 *	Accepts:	- ptr to two entries
 *	Returns:	- 0 if same communicator, else 1
 */
static int
check_cid(c1, c2)

MPI_Comm		*c1, *c2;

{
	return( !( ((*c1)->c_contextid == (*c2)->c_contextid)
			|| ((*c1)->c_contextid == -((*c2)->c_contextid + 1))));
}

/*
 *	init_f77
 *
 *	Function:	- initialization for F77
 *	Returns:	- 0 or LAMERROR
 */
static int
init_f77(void)

{
/*
 * Initialize the type lookup table.
 */
	lam_F_sizehdlarray = LAM_TYPETBLSIZE;
	lam_F_handles = (void **) malloc(lam_F_sizehdlarray * sizeof(void *));
	if (lam_F_handles == 0) {
		return(LAMERROR);
	}

	memset((char *) lam_F_handles, 0, lam_F_sizehdlarray * sizeof(void *));
	lam_F_nhdl = 0;
/*
 * These must be done in an order that matches the indices given to the
 * F77 constants in mpif.h.
 */
	MPI_COMM_WORLD->c_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_COMM_WORLD;
	MPI_COMM_SELF->c_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_COMM_SELF;

	MPI_GROUP_EMPTY->g_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_GROUP_EMPTY;

	MPI_ERRORS_ARE_FATAL->eh_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_ERRORS_ARE_FATAL;
	MPI_ERRORS_RETURN->eh_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_ERRORS_RETURN;

	MPI_BYTE->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_BYTE;
	MPI_PACKED->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_PACKED;
	MPI_UB->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_UB;
	MPI_LB->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LB;
	MPI_F_CHARACTER->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_CHARACTER;
	MPI_F_LOGICAL->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_LOGICAL;
	MPI_F_INTEGER->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_INTEGER;
	MPI_F_REAL->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_REAL;
	MPI_F_DOUBLE_PRECISION->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_DOUBLE_PRECISION;
	MPI_F_COMPLEX->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_COMPLEX;
	MPI_F_DOUBLE_COMPLEX->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_DOUBLE_COMPLEX;
	MPI_F_2REAL->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_2REAL;
	MPI_F_2DOUBLE_PRECISION->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_2DOUBLE_PRECISION;
	MPI_F_2INTEGER->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_F_2INTEGER;

	MPI_MAX->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_MAX;
	MPI_MIN->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_MIN;
	MPI_SUM->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_SUM;
	MPI_PROD->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_PROD;
	MPI_LAND->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LAND;
	MPI_BAND->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_BAND;
	MPI_LOR->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LOR;
	MPI_BOR->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_BOR;
	MPI_LXOR->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LXOR;
	MPI_BXOR->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_BXOR;
	MPI_MAXLOC->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_MAXLOC;
	MPI_MINLOC->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_MINLOC;
	MPI_REPLACE->op_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_REPLACE;
/*
 * We must also register the groups associated with MPI_COMM_WORLD
 * and MPI_COMM_SELF.
 */
	MPI_COMM_WORLD->c_group->g_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_COMM_WORLD->c_group;
	MPI_COMM_SELF->c_group->g_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_COMM_SELF->c_group;
/*
 * The C basic types are also registered to allow user of the F77 handle
 * as an integer type identifier in one-sided communication.
 */
	MPI_CHAR->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_CHAR;
	MPI_SHORT->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_SHORT;
	MPI_INT->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_INT;
	MPI_LONG->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LONG;
	MPI_FLOAT->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_FLOAT;
	MPI_DOUBLE->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_DOUBLE;
	MPI_LONG_DOUBLE->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LONG_DOUBLE;
	MPI_UNSIGNED_CHAR->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_UNSIGNED_CHAR;
	MPI_UNSIGNED_SHORT->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_UNSIGNED_SHORT;
	MPI_UNSIGNED_LONG->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_UNSIGNED_LONG;
	MPI_UNSIGNED->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_UNSIGNED;
	MPI_WCHAR->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_WCHAR;
	MPI_LONG_LONG_INT->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_LONG_LONG_INT;
	MPI_UNSIGNED_LONG_LONG->dt_f77handle = lam_F_nhdl;
	lam_F_handles[lam_F_nhdl++] = MPI_UNSIGNED_LONG_LONG;

	lam_F_maxhdl = lam_F_nhdl - 1;
	if (lam_F_nhdl != LAM_MAXF77PREDEF) {
	    errno = EIMPOSSIBLE;
	    return(LAMERROR);
	}
/*
 * Initialize F77 constants which correspond to addresses.
 */
	lam_F_bottom = (char *) &mpi_bottom_[0];
	lam_F_argvnull = &mpi_argv_null_[0];
	lam_F_argvsnull = &mpi_argvs_null_[0];
	lam_F_errorcodes_ignore = &mpi_errcodes_ignore[0];
	lam_F_status_ignore = &mpi_status_ignore[0];
	lam_F_statuses_ignore = &mpi_statuses_ignore[0];

	MPI_F_STATUS_IGNORE = (MPI_Fint *) lam_F_status_ignore;
	MPI_F_STATUSES_IGNORE = (MPI_Fint *) lam_F_statuses_ignore;

	return(0);
}
