/*
 *	pvm_gsulib.c
 *
 *	Group server user library routines
 *
$Log: pvm_gsulib.c,v $
 * Revision 1.4  1994/11/07  21:09:38  manchek
 * include stdlib if available.
 * function prototypes for SCO.
 * remove spurious breaks after returns
 *
 * Revision 1.3  1994/10/15  21:57:34  manchek
 * disable output collection and tracing while spawning group server
 *
 * Revision 1.2  1994/10/15  18:53:48  manchek
 * added tids to BCAST1 trace message
 *
 *
 *	05 Mar 1993	Adam Beguelin adamb@cs.cmu.edu
 *	05 Mar 1993	Fixed malloc() in pvm_bcast()
 *	05 Mar 1993	pvm_barrier now returns 0 or an error
 *	20 Mar 1993	pvm_bcast does not send to itself, beguelin
 *      01 Jun 1993     Fixed saving and restoring of mbufs, beguelin
 *	30 Nov 1993     Fixed gs_getgstid() to check spawn return correctly,
 *                      manchek
 *       8 Mar 1994     optimized gs_getgstid(). 
 *       8 Mar 1994     Added reduce & assoc routines. Donato & P.Papadopoulos
 *      24 Apr 1994     Added scatter, gather, gs_get_datasize routines. Donato
 * 
 */


#ifdef HASSTDLIB
#include <stdlib.h>
#endif
#include <stdio.h>
#include "pvm3.h"
#include "pvmgdef.h"
#include <pvmtev.h>
#include "../src/tevmac.h"
#include "../src/bfunc.h"

int gstid = -1;
extern int pvm_errno;
extern int pvmmytid;
extern int pvmtoplvl;
extern int pvmtrctid;
extern Pvmtmask pvmtrcmask;

/*
	gs_getgstid returns the tid of the group server
	if the groupserver isn't running, start it
*/

int
gs_getgstid()
{
	int info;
	int otid, ttid;

	if (gstid >= 0) return (gstid);
	info = pvm_lookup(GSNAME, 0, &gstid);
	/* if it's not there */
	if (info == PvmNoEntry) {

		otid = pvm_setopt(PvmOutputTid, 0);
		ttid = pvm_setopt(PvmTraceTid, 0);
		info = pvm_spawn("pvmgs", (char **)0, PvmMppFront,
				(char *)0, 1, &gstid);
		pvm_setopt(PvmOutputTid, otid);
		pvm_setopt(PvmTraceTid, ttid);
		if (info != 1) {
			if (info == 0 && gstid < 0) {
				pvm_errno = gstid;
				pvm_perror("gs_getgstid() failed to start group server");
			}
			return pvm_errno;
		}
		/* wait for it to register */
		while(pvm_lookup(GSNAME, 0, &gstid))
			;
			/*
			fputs("waiting on group server to register\n",stderr);
			*/
	}
	return(gstid);
}

/*

int inum = pvm_joingroup(char* group)

  Adds the calling tid to the named group and returns its instance number.
  Always adds the task in the first available slot such that
  if one task leaves a group and another later joins, then the later
  task will get the instance number freed by the earlier task.
  This allows users to keep a contiguous block of instance numbers [0,p-1].

*/

int
pvm_joingroup(group)
	char *group;
{
	int sbuf, rbuf, gid;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_JOINGROUP0)) {
			pvm_pkstr(group ? group : "");
			TEV_FIN;
		}
	}

	if (group == (char*)0)
		gid = PvmNullGroup;

	else {

	/* find out who the server's tid, start the server if need be */
		gstid = gs_getgstid();
		if (gstid < 0) {
			gid = PvmSysErr;

		} else {

	/* send the group name to the server */
			if ((sbuf = pvm_mkbuf(PvmDataDefault)) < 0)
				pvm_perror("pvm_joingroup");
			if ((sbuf = pvm_setsbuf(sbuf)) < 0)
				pvm_perror("pvm_joingroup");
			if (pvm_pkstr(group) < 0)
				pvm_perror("pvm_joingroup");
			if (pvm_send(gstid, JOIN) < 0)
				pvm_perror("pvm_joingroup");

	/* get the group id back from the server */
			if ((rbuf = pvm_setrbuf(0)) < 0)
				pvm_perror("pvm_joingroup");
			if (pvm_recv(gstid, JOIN) < 0)
				pvm_perror("pvm_joingroup");
			if (pvm_upkint(&gid, 1, 1) < 0)
				pvm_perror("pvm_joingroup");

	/* restore the users mbufs */
			pvm_freebuf(pvm_setsbuf(sbuf));
			pvm_freebuf(pvm_setrbuf(rbuf));
		}
	}

	if (x) {
		if (TEV_DO_TRACE(TEV_JOINGROUP1)) {
			pvm_pkint(&gid, 1, 1);
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (gid < 0)
		pvm_errno = gid;
	return gid;
}


/*

int info = pvm_lvgroup(char* group)

  Removes the calling tid from the named group.
  Returns only after getting confirmation from server.
  This allows users to coordinate leaving and joining.

*/

int
pvm_lvgroup(group)
	char *group;
{
	int sbuf, rbuf;
	int rc;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_LVGROUP0)) {
			pvm_pkstr(group ? group : "");
			TEV_FIN;
		}
	}

	/* check for null group */
	if (group == (char*)0)
		rc = PvmNullGroup;

	else {

	/* if the group server isn't started */
		if (gstid == -1)
			rc = PvmNotInGroup;

		else {

	/* send the group name to the server */
			sbuf = pvm_mkbuf(PvmDataDefault);
			sbuf = pvm_setsbuf(sbuf);
			pvm_pkstr(group);
			pvm_send(gstid, LEAVE);

	/* get the return code back from the server */
			rbuf = pvm_setrbuf(0);
			pvm_recv(gstid, LEAVE);
			pvm_upkint(&rc, 1, 1);

	/* restore the users mbufs */
			pvm_freebuf(pvm_setsbuf(sbuf));
			pvm_freebuf(pvm_setrbuf(rbuf));
		}
	}

	if (x) {
		if (TEV_DO_TRACE(TEV_LVGROUP1)) {
			pvm_pkint(&rc, 1, 1);
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (rc < 0)
		pvm_errno = rc;
	return(rc);
}


/*

int inum = pvm_getinst(char* group, int tid)

  Returns the instance number of the specified tid in the named group.
  Can be called by any task.

*/

int
pvm_getinst(group, tid)
	char *group;
	int tid;
{
	int sbuf, rbuf, inst;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_GETINST0)) {
			pvm_pkstr(group ? group : "");
			pvm_pkint(&tid, 1, 1);
			TEV_FIN;
		}
	}

	/* check for a null group name */
	if (group == (char*)0)
		inst = PvmNullGroup;

	else {

	/* find out who the server's tid, start the server if need be */
		gstid = gs_getgstid();
		if (gstid < 0)
			inst = PvmSysErr;

		else {	

	/* send the group name to the server */
			sbuf = pvm_mkbuf(PvmDataDefault);
			sbuf = pvm_setsbuf(sbuf);
			pvm_pkstr(group);
			pvm_pkint(&tid, 1, 1);

			pvm_send(gstid, GETINST);

	/* get the group id back from the server */
			rbuf = pvm_setrbuf(0);
			pvm_recv(gstid, GETINST);
			pvm_upkint(&inst, 1, 1);

	/* restore the users mbufs */
			pvm_freebuf(pvm_setsbuf(sbuf));
			pvm_freebuf(pvm_setrbuf(rbuf));
		}
	}

	if (x) {
		if (TEV_DO_TRACE(TEV_GETINST1)) {
			pvm_pkint(&inst, 1, 1);
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (inst < 0)
		pvm_errno = inst;
	return(inst);
}

/*

int tid = pvm_gettid(char * group, int inum)

  Returns the tid of the task defined by the group/inum pair.
  Can be called by any task.


*/

int
pvm_gettid(group, inst)
	char *group;
	int inst;
{
	int sbuf, rbuf, tid;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_GETTID0)) {
			pvm_pkstr(group ? group : "");
			pvm_pkint(&inst, 1, 1);
			TEV_FIN;
		}
	}

	if (group == (char*)0)
		tid = PvmNullGroup;

	else {

	/* find out who the server's tid, start the server if need be */
		gstid = gs_getgstid();
		if (gstid < 0)
			tid = PvmSysErr;

		else {

	/* send the group name to the server */
			sbuf = pvm_mkbuf(PvmDataDefault);
			sbuf = pvm_setsbuf(sbuf);
			if (pvm_pkstr(group) < 0)
				pvm_perror("pvm_gettid");
			if (pvm_pkint(&inst, 1, 1) < 0)
				pvm_perror("pvm_gettid");

			if (pvm_send(gstid, GETTID) < 0)
				pvm_perror("pvm_gettid");

	/* get the group id back from the server */
			rbuf = pvm_setrbuf(0);
			if (pvm_recv(gstid, GETTID) < 0)
				pvm_perror("pvm_gettid");
			if (pvm_upkint(&tid, 1, 1) < 0)
				pvm_perror("pvm_gettid");

	/* restore the users mbufs */
			pvm_freebuf(pvm_setsbuf(sbuf));
			pvm_freebuf(pvm_setrbuf(rbuf));
		}
	}

	if (x) {
		if (TEV_DO_TRACE(TEV_GETTID1)) {
			pvm_pkint(&tid, 1, 1);
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (tid < 0)
		pvm_errno = tid;
	return(tid);
}

/*

int gsize = pvm_gsize(char* group)

  Returns the present size of the named group.

*/

int
pvm_gsize(group)
	char *group;
{
	int sbuf, rbuf, size;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_GSIZE0)) {
			pvm_pkstr(group ? group : "");
			TEV_FIN;
		}
	}

	if (group == (char*)0)
		size = PvmNullGroup;
	else {

	/* find out who the server's tid, start the server if need be */
		gstid = gs_getgstid();
		if (gstid < 0)
			size = PvmSysErr;

		else {

	/* send the group name to the server */
			sbuf = pvm_mkbuf(PvmDataDefault);
			sbuf = pvm_setsbuf(sbuf);
			pvm_pkstr(group);
			pvm_send(gstid, GSIZE);

	/* get the group id back from the server */
			rbuf = pvm_setrbuf(0);
			pvm_recv(gstid, GSIZE);
			pvm_upkint(&size, 1, 1);

	/* restore the users mbufs */
			pvm_freebuf(pvm_setsbuf(sbuf));
			pvm_freebuf(pvm_setrbuf(rbuf));
		}
	}

	if (x) {
		if (TEV_DO_TRACE(TEV_GSIZE1)) {
			pvm_pkint(&size, 1, 1);
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (size < 0)
		pvm_errno = size;
	return(size);
}

/*

int info = pvm_bcast(char* group, int msgtag)

  Broadcast message to all members presently in the named group
  (excluding yourself if you are in the group).
  Calling tid need not be in the group.

*/


int
pvm_bcast(group, msgtag)
	char *group;
	int msgtag;
{
	int sbuf, rbuf;
	int ntids, *tids = 0, cc, i, mytid;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_BCAST0)) {
			pvm_pkstr(group ? group : "");
			pvm_pkint(&msgtag, 1, 1);
			TEV_FIN;
		}
	}

        if ((cc = gs_get_tidlist(group, msgtag, &ntids, &tids, 0)) < 0)
		goto done;

	/* get my tid */
	if ((mytid = pvm_mytid()) < 0) {
		pvm_perror("pvm_bcast");
		cc = PvmSysErr;
		goto done;
	}

	/* if I'm the only one in the group */
	if ((ntids == 1) && (tids[0] == mytid )) {
		cc = PvmNoInst;
		goto done;
	}

	/* remove my tid */
	for (i = 0; i < ntids; i++)
		if (tids[i] == mytid) {
			/* move the last tid to here and shorten the list */
			tids[i] = tids[--ntids];
			break;
		}

	/* finally send the damn thing */
	if ((cc = pvm_mcast(tids, ntids, msgtag)) > 0)
		cc = 0;

done:
	if (cc < 0)
		pvm_errno = cc;

	if (x) {
		if (TEV_DO_TRACE(TEV_BCAST1)) {
			pvm_pkint(&cc, 1, 1);
			if (cc < 0) {
				ntids = -1;
				pvm_pkint(&ntids, 1, 1);

			} else {
				pvm_pkint(&ntids, 1, 1);
				pvm_pkint(tids, ntids, 1);
			}
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (tids)
		free(tids);

	return(cc);
}


/*

int info = pvm_barrier(char* group, int count)

  Calling task waits until count members of named group also
  call pvm_barrier. If user places -1 for count then the present
  size of the group is used. Note this option is not useful if
  the size of the group is changing.

  A process must be a member of a group to call pvm_barrier on
  that group

*/

int
pvm_barrier(group, cnt)
	char  *group;
	int cnt;
{
	int sbuf, rbuf;
	int cc;
	int x;

	if (x = pvmtoplvl) {
		pvmtoplvl = 0;
		if (TEV_DO_TRACE(TEV_BARRIER0)) {
			pvm_pkstr(group ? group : "");
			pvm_pkint(&cnt, 1, 1);
			TEV_FIN;
		}
	}

	if (group == (char*)0)
		cc = PvmNullGroup;
	else {

	/* find out who the server's tid, start the server if need be */
		gstid = gs_getgstid();
		if (gstid < 0)
			cc = PvmSysErr;

		else {

	/* send the group name and barrier count to the server */
			sbuf = pvm_mkbuf(PvmDataDefault);
			sbuf = pvm_setsbuf(sbuf);
			pvm_pkstr(group);
			pvm_pkint(&cnt, 1, 1);
			rbuf = pvm_setrbuf(0);
			pvm_send(gstid, BARRIER);

	/* get the barrier ack back from the server */
			pvm_recv(gstid, BARRIER);
			pvm_upkint(&cc, 1, 1);

	/* restore the users mbufs */
			pvm_freebuf(pvm_setsbuf(sbuf));
			pvm_freebuf(pvm_setrbuf(rbuf));

			if (cc > 0)
				cc = 0;
		}
	}

	if (x) {
		if (TEV_DO_TRACE(TEV_BARRIER1)) {
			pvm_pkint(&cc, 1, 1);
			TEV_FIN;
		}
		pvmtoplvl = 1;
	}

	if (cc < 0)
		pvm_errno = cc;
	return(cc);

}

/*
	ask pvmgs to dump it's state
	assumes pvmgs is running
*/

void
pvm_gsdump()
{
	int sbuf;

	sbuf = pvm_mkbuf(PvmDataDefault);
	sbuf = pvm_setsbuf(sbuf);
	pvm_send(gstid, DUMP);

	pvm_freebuf(pvm_setsbuf(sbuf));

}

/*  
      int info = pvm_reduce(
                  void (*func)(int *datatype, *data, *count *info), 
                  void *data, int count, int datatype, 
                  int msgtag, char *gname, int rootinst)

      Each group member passes their data to the root
      which then performs the specified function combining
      its own data and the data from the group members.
*/

int 
pvm_reduce(func, data, count, datatype, msgtag, gname, rootinst)
#ifdef	IMA_SCO
     void (*func)(int*, void*, void*, int*, int*);
#else
     void (*func)();
#endif
     void *data;
     int count, datatype, msgtag, rootinst;
     char *gname; 
{
     int mytid, myginst, i, gsize, info, cc;
     int roottid, datasize;
     void *work;      /* This will be a calloc'ed work array */

     int sbuf, rbuf;
     int (*packfunc)(), (*unpackfunc)();
     int x;

     if (x = pvmtoplvl) 
       {
       pvmtoplvl = 0;
       if (TEV_DO_TRACE(TEV_REDUCE0)) 
         {
         pvm_pkstr(gname ? gname : "");
         pvm_pkint(&msgtag, 1, 1);
         TEV_FIN;
         }
       }

     if ( (data == NULL) || (count <= 0) ) /* check some parameters */
       {
       cc = PvmBadParam;
       goto done;
       }

     /* set up pointers to the appropriate pack and unpack routines */
     if ( (info = gs_pack_unpack(datatype, &packfunc, &unpackfunc) ) < 0)
       {
       cc = info;
       goto done;
       }
   
     if ( (roottid = pvm_gettid(gname,rootinst)) < 0 )
       {
       cc = roottid;
       goto done;
       }

     mytid = pvm_mytid();

     /* get instance number - caller must be in group */
     if ( (myginst = pvm_getinst(gname, mytid)) < 0 )
       {
       cc = myginst;
       goto done;
       }

     /* I am the root node for the reduce operation 
        Perform the specified function after receiving
        work values from each of the group members.
     */
     if (myginst == rootinst)
     {
       if ( (gsize = pvm_gsize(gname)) < 0 )
         {
         cc = gsize;
         goto done;
         }

       /*  if roottid is the only one in the group then we're done */
       if ( gsize == 1 )
         {
         cc = PvmOk;
         goto done;
         }

       /* get data from group members and perform the function */
       if ( (datasize = gs_get_datasize(datatype)) < 0)
         {
         cc = datasize;
         goto done;
         }

       /* don't count the root since in the group */
       gsize--;

       rbuf = pvm_setrbuf(0);

       for (i=0; i<gsize; i++) 
       {
          if ((work = (void *) calloc(count, datasize)) == NULL)
            {
            pvm_freebuf(pvm_setrbuf(rbuf));    /* restore users receive buf */
            cc = PvmSysErr;
            goto done;
            }
            
          if ( (info = pvm_recv( -1, msgtag )) < 0)
            {
            pvm_freebuf(pvm_setrbuf(rbuf));    /* restore users receive buf */
            cc = info;
            goto done;
            }
  
          if ( (info = (*unpackfunc)( work, count, 1) ) < 0)
            {
            pvm_freebuf(pvm_setrbuf(rbuf));    /* restore users receive buf */
            cc = info;
            goto done;
            }

          (*func)( &datatype, data, work, &count, &info );
          free(work);

          /* something went wrong in func */
          if (info < PvmOk)
          {
            pvm_freebuf(pvm_setrbuf(rbuf));    /* restore users receive buf */
            cc = info;   /* return the error */
            goto done;
          }
            
       } /* for-loop */

       /* restore the users receive buf */
       pvm_freebuf(pvm_setrbuf(rbuf));

       /* If desired, we could now broadcast result back to the group.  */

     } 
     else  /* member of group but not the root instance */
     {
         sbuf = pvm_mkbuf(PvmDataDefault);
         sbuf = pvm_setsbuf(sbuf);

         if ( (info = (*packfunc)( data, count, 1) ) < 0 )
           {
           pvm_freebuf(pvm_setsbuf(sbuf));    /* restore users send buf */
           cc = info;
           goto done;
           }
         if ( (info = pvm_send( roottid, msgtag)) < 0 )
           {
           pvm_freebuf(pvm_setsbuf(sbuf));    /* restore users send buf */
           cc = info;
           goto done;
           }

         pvm_freebuf(pvm_setsbuf(sbuf));    /* restore users send buf */
      }

  cc = PvmOk;

done:

  if (cc < 0) 
    {
    pvm_errno = cc;
    pvm_perror("pvm_reduce");
    }

  if (x) 
    {
    if (TEV_DO_TRACE(TEV_REDUCE1)) 
      {
      pvm_pkint(&cc, 1, 1);
      TEV_FIN;
      }
    pvmtoplvl = 1;
    }
  
  return(cc);

}  /* end of pvm_reduce() */




/*  
  int info = gs_pack_unpack( int datatype, 
                             int (**packfunc)(), int (**unpackfunc)() )

  Sets up pointers to the appropriate pack and unpack function based
  on datatype specified.

*/

int 
gs_pack_unpack(datatype, packfunc, unpackfunc)
int datatype, (**packfunc)(), (**unpackfunc)();
{

  switch(datatype) 
  {
     case (PVM_STR):  
       *packfunc = pvm_pkstr; 
       *unpackfunc = pvm_upkstr; 
       break;
     case (PVM_BYTE):  
       *packfunc = pvm_pkbyte; 
       *unpackfunc = pvm_upkbyte; 
       break;
     case (PVM_SHORT):
       *packfunc = pvm_pkshort; 
       *unpackfunc = pvm_upkshort; 
       break;
     case (PVM_INT):
       *packfunc = pvm_pkint;
       *unpackfunc = pvm_upkint; 
       break;
     case (PVM_LONG):      
       *packfunc = pvm_pklong; 
       *unpackfunc = pvm_upklong; 
       break;
     case (PVM_FLOAT):
       *packfunc = pvm_pkfloat; 
       *unpackfunc = pvm_upkfloat; 
       break;
     case (PVM_DOUBLE):
       *packfunc = pvm_pkdouble; 
       *unpackfunc = pvm_upkdouble; 
       break;
     case (PVM_CPLX):
       *packfunc = pvm_pkcplx; 
       *unpackfunc = pvm_upkcplx; 
       break;
     case (PVM_DCPLX):
       *packfunc = pvm_pkdcplx; 
       *unpackfunc = pvm_upkdcplx; 
       break;
    default:
       return(PvmBadParam);
  }

  return(PvmOk);
}   /* end of gs_pack_unpack() */


#ifndef min
#define min(x,y) ((x)<(y)?(x):(y))
#endif 
#ifndef max
#define max(x,y) ((x)>(y)?(x):(y))
#endif
/* 
  void PvmMax(int *datatype, void *x, void *y, int *num, int *info)

  Assigns the elements of x the maximum value between the
  corresponding elements of x and y.  
  For complex values the maximum is determined by maximum modulus.


*/

void 
PvmMax(datatype, x, y, num, info)
int *datatype;
void *x, *y; 
int *num, *info;
{
  char   *xchar,   *ychar;
  int    *xint,    *yint;
  short  *xshort,  *yshort;
  long   *xlong,   *ylong;
  float  *xfloat,  *yfloat;
  double *xdouble, *ydouble;
  float   xfreal, xfimag, yfreal, yfimag;
  double  xdreal, xdimag, ydreal, ydimag;
  float   xsqrfloat, ysqrfloat;
  double  xsqrdouble, ysqrdouble;
  
  int i, count;

  count = *num;

  switch(*datatype) 
  {
     case (PVM_BYTE):
       xchar = (char *) x;
       ychar = (char *) y;
       for (i=0; i<count; i++) xchar[i] = max(xchar[i], ychar[i]);
       break;
     case (PVM_SHORT):
       xshort = (short *) x;
       yshort = (short *) y;
       for (i=0; i<count; i++) xshort[i] = max(xshort[i], yshort[i]);
       break;
     case (PVM_INT):
       xint = (int *) x;
       yint = (int *) y;
       for (i=0; i<count; i++) xint[i] = max(xint[i], yint[i]);
       break;
     case (PVM_LONG):
       xlong = (long *) x;
       ylong = (long *) y;
       for (i=0; i<count; i++) xlong[i] = max(xlong[i], ylong[i]);
       break;
     case (PVM_FLOAT):
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<count; i++) xfloat[i] = max(xfloat[i], yfloat[i]);
       break;
     case (PVM_DOUBLE):
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<count; i++) xdouble[i] = max(xdouble[i], ydouble[i]);
       break;
     case (PVM_CPLX):
       /* complex - complex*8 in fortran - treated as two floats */
       /* returns the complex pair with the greatest magnitude */
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<2*count; i+=2)
         {
         xfreal = xfloat[i];
         xfimag = xfloat[i+1];
         yfreal = yfloat[i];
         yfimag = yfloat[i+1];
         xsqrfloat = xfreal*xfreal + xfimag*xfimag;
         ysqrfloat = yfreal*yfreal + yfimag*yfimag;
         if (ysqrfloat > xsqrfloat)
           {
           xfloat[i]   = yfreal;
           xfloat[i+1] = yfimag;
           }
         }
       break;
     case (PVM_DCPLX):
       /* double complex - complex*16 in fortran - treated as two doubles */
       /* returns the complex pair with the greatest magnitude */
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<2*count; i+=2)
         {
         xdreal = xdouble[i];
         xdimag = xdouble[i+1];
         ydreal = ydouble[i];
         ydimag = ydouble[i+1];
         xsqrdouble = xdreal*xdreal + xdimag*xdimag;
         ysqrdouble = ydreal*ydreal + ydimag*ydimag;
         if (ysqrdouble > xsqrdouble)
           {
           xdouble[i]   = ydreal;
           xdouble[i+1] = ydimag;
           }
         }
       break;
     default:
       *info = PvmBadParam;
       return;
  }  /* end switch */

 *info = PvmOk;
 return;

}  /* end of PvmMax() */


/* 
  void PvmMin(int *datatype, void *x, void *y, int *num, int *info)

  Assigns the elements of x the minimum value between the
  corresponding elements of x and y.
  For complex values the minimum is determined by minimum modulus.

*/

void 
PvmMin(datatype, x, y, num, info)
int *datatype;
void *x, *y;
int  *num, *info;
{
  char   *xchar,   *ychar;
  short  *xshort,  *yshort;
  int    *xint,    *yint;
  long   *xlong,   *ylong;
  float  *xfloat,  *yfloat;
  double *xdouble, *ydouble;
  float   xfreal, xfimag, yfreal, yfimag;
  double  xdreal, xdimag, ydreal, ydimag;
  float   xsqrfloat, ysqrfloat;
  double  xsqrdouble, ysqrdouble;

  int i, count;

  count = *num;

  switch(*datatype) 
  {
     case (PVM_BYTE):
       xchar = (char *) x;
       ychar = (char *) y;
       for (i=0; i<count; i++) xchar[i] = min(xchar[i], ychar[i]);
       break;
     case (PVM_SHORT):
       xshort = (short *) x;
       yshort = (short *) y;
       for (i=0; i<count; i++) xshort[i] = min(xshort[i], yshort[i]);
       break;
     case (PVM_INT):
       xint = (int *) x;
       yint = (int *) y;
       for (i=0; i<count; i++) xint[i] = min(xint[i], yint[i]);
       break;
     case (PVM_LONG):
       xlong = (long *) x;
       ylong = (long *) y;
       for (i=0; i<count; i++) xlong[i] = min(xlong[i], ylong[i]);
       break;
     case (PVM_FLOAT):
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<count; i++) xfloat[i] = min(xfloat[i], yfloat[i]);
       break;
     case (PVM_DOUBLE):
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<count; i++) xdouble[i] = min(xdouble[i], ydouble[i]);
       break;
     case (PVM_CPLX):
       /* complex - complex*8 in fortran - treated as two floats */
       /* returns the complex pair with the smaller magnitude */
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<2*count; i+=2)
         {
         xfreal = xfloat[i];
         xfimag = xfloat[i+1];
         yfreal = yfloat[i];
         yfimag = yfloat[i+1];
         xsqrfloat = xfreal*xfreal + xfimag*xfimag;
         ysqrfloat = yfreal*yfreal + yfimag*yfimag;
         if (ysqrfloat < xsqrfloat)
           {
           xfloat[i]   = yfreal;
           xfloat[i+1] = yfimag;
           }
         }
       break;
     case (PVM_DCPLX):
       /* double complex - complex*16 in fortran - treated as two doubles */
       /* returns the complex pair with the smaller magnitude */
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<2*count; i+=2)
         {
         xdreal = xdouble[i];
         xdimag = xdouble[i+1];
         ydreal = ydouble[i];
         ydimag = ydouble[i+1];
         xsqrdouble = xdreal*xdreal + xdimag*xdimag;
         ysqrdouble = ydreal*ydreal + ydimag*ydimag;
         if (ysqrdouble < xsqrdouble)
           {
           xdouble[i]   = ydreal;
           xdouble[i+1] = ydimag;
           }
         }
       break;
     default:
       *info = PvmBadParam;
       return;
  }  /* end switch */

  *info = PvmOk;
  return;

}  /* end of PvmMin() */

/* 
  void PvmSum(int *datatype, void *x, void *y, *num, *info)

  Assigns the elements of x the sum of the corresponding elements of x and y.

*/

void 
PvmSum(datatype, x, y, num, info)
int *datatype;
void *x, *y;
int *num, *info;
{
  short  *xshort,  *yshort;
  int    *xint,    *yint;
  long   *xlong,   *ylong;
  float  *xfloat,  *yfloat;
  double *xdouble, *ydouble;

  int i, count;

  count = *num;

  switch(*datatype) 
  {
     case (PVM_SHORT):
       xshort = (short *) x;
       yshort = (short *) y;
       for (i=0; i<count; i++) xshort[i] += yshort[i];
       break;
     case (PVM_INT):
       xint = (int *) x;
       yint = (int *) y;
       for (i=0; i<count; i++) xint[i] += yint[i];
       break;
     case (PVM_LONG):
       xlong = (long *) x;
       ylong = (long *) y;
       for (i=0; i<count; i++) xlong[i] += ylong[i];
       break;
     case (PVM_FLOAT):
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<count; i++) xfloat[i] += yfloat[i];
       break;
     case (PVM_DOUBLE):
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<count; i++) xdouble[i] += ydouble[i];
       break;
     case (PVM_CPLX):
       /* complex - complex*8 in fortran - treated as two floats */
       /* returns the sum of the two complex pairs */
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<2*count; i++) xfloat[i]  += yfloat[i];
       break;
     case (PVM_DCPLX):
       /* double complex - complex*16 in fortran - treated as two doubles */
       /* returns the sum of the two complex pairs */
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<2*count; i++) xdouble[i]   += ydouble[i];
       break;
     default:
       *info = PvmBadParam;
       return;
  }  /* end switch */

  *info = PvmOk;
  return;

}  /* end of PvmSum() */
/* 
  void PvmProduct(int *datatype, void *x, void *y, *num, *info)

  Assigns the elements of x the sum of the corresponding elements of x and y.

*/

void 
PvmProduct(datatype, x, y, num, info)
int *datatype;
void *x, *y;
int *num, *info;
{
  short  *xshort,  *yshort;
  int    *xint,    *yint;
  long   *xlong,   *ylong;
  float  *xfloat,  *yfloat, a,b,c,d;
  double *xdouble, *ydouble, da,db,dc,dd;

  int i, count;

  count = *num;

  switch(*datatype) 
  {
     case (PVM_SHORT):
       xshort = (short *) x;
       yshort = (short *) y;
       for (i=0; i<count; i++) xshort[i] *= yshort[i];
       break;
     case (PVM_INT):
       xint = (int *) x;
       yint = (int *) y;
       for (i=0; i<count; i++) xint[i] *= yint[i];
       break;
     case (PVM_LONG):
       xlong = (long *) x;
       ylong = (long *) y;
       for (i=0; i<count; i++) xlong[i] *= ylong[i];
       break;
     case (PVM_FLOAT):
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<count; i++) xfloat[i] *= yfloat[i];
       break;
     case (PVM_DOUBLE):
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<count; i++) xdouble[i] *= ydouble[i];
       break;
     case (PVM_CPLX):
       /* complex - complex*8 in fortran - treated as two floats */
       /* returns the product of the two complex pairs */
       xfloat = (float *) x;
       yfloat = (float *) y;
       for (i=0; i<2*count; i += 2) 
       {
            a = xfloat[i]; b = xfloat[i+1], c = yfloat[i]; d = yfloat[i+1];
            xfloat[i] = a*c - b*d;
            xfloat[i+1] = a*d + b*c;
       }
       break;
     case (PVM_DCPLX):
       /* double complex - complex*16 in fortran - treated as two doubles */
       /* returns the  product of the two complex pairs */
       xdouble = (double *) x;
       ydouble = (double *) y;
       for (i=0; i<2*count; i+= 2) 
       {
            da = xdouble[i]; db = xdouble[i+1], 
            dc = ydouble[i]; dd = ydouble[i+1];
            xdouble[i] = da*dc - db*dd;
            xdouble[i+1] = da*dd + db*dc;
       }
       break;
     default:
       *info = PvmBadParam;
       return;
  }  /* end switch */

  *info = PvmOk;
  return;

}  /* end of PvmProduct() */





/*    
  int info = pvm_gather(void *result, void *data, int count, int datatype, 
                        int msgtag,  char *gname, int rootinst)

  Performs a gather of messages from each member of the group
  to a specified member of the group.

  Each member of the group 'gname' sends a message 'data' 
  of type 'datatype' and length 'count' to the root member of the group.
  The root receives these messages into a single array 'result'
  which is of length, at least, (number of group members)*'count'.
  The values received from the ith member of the group are
  placed into the 'result' array starting at position i*'count'.
  The root member of the group is specified by its instance number,
  'rootginst', in that group.
*/
 


int 
pvm_gather(result, data, count, datatype, msgtag, gname, rootinst)
void *result, *data;
int  count, datatype, msgtag, rootinst;
char *gname;
{
  int mytid, roottid, myginst, datasize, gsize, *tids = 0, i, cc;
  int sbuf, rbuf;

  int (*packfunc)(), (*unpackfunc)();  /* ptrs to pack and unpack functions */
  int x;

  if (x = pvmtoplvl) 
    {
    pvmtoplvl = 0;
    if (TEV_DO_TRACE(TEV_GATHER0)) 
      {
      pvm_pkstr(gname ? gname : "");
      pvm_pkint(&msgtag, 1, 1);
      TEV_FIN;
      }
    }

  if ( (data == NULL) || (count <= 0) ) /* check some parameters */
    {
    cc = PvmBadParam;
    goto done;
    }

  /* set up pointers to the appropriate pack and unpack routines */
  if ( (cc = gs_pack_unpack(datatype, &packfunc, &unpackfunc) ) < 0)
    goto done;

  /* root must be member of the group */
  if ( (roottid = pvm_gettid(gname,rootinst)) < 0 )
    {
    cc = roottid;
    goto done;
    }

  mytid = pvm_mytid();

  /* get instance number - caller must be in group */
  if ( (myginst = pvm_getinst(gname, mytid)) < 0 )
    {
    cc = myginst; 
    goto done;
    }

  if (myginst == rootinst)     /* I am the root for the gather operation */
    {
    if ( result == NULL) /* check result parameter */
      {
      cc = PvmBadParam;
      goto done;
      }

    /* get the number of bytes per element of type datatype */
    if ( (datasize = gs_get_datasize(datatype)) < 0  ) 
      {
      cc = datasize;
      goto done;
      }

    /* Get the list of tids.  These must be contiguous (no holes). */
    if ( (cc = gs_get_tidlist(gname, msgtag, &gsize, &tids, 1)) < 0)
      goto done;

    rbuf = pvm_setrbuf(0);

    /* Get the values, put them in the correct place in the result. 
       The instance numbers should be contiguous within the group.
    */
    for (i=0; i<gsize; i++)
      {
      /* The root copies its data into its result array */
      if (i == myginst) 
        {
        BCOPY((char *) data, (char *) result + i*datasize*count, 
              datasize*count);
        }
      else
        {

        if ( (cc = pvm_recv( tids[i], msgtag )) < 0 )
          {
          pvm_freebuf(pvm_setrbuf(rbuf)); /* restore user's receive buf */
          goto done;
          }
        if ((cc =(*unpackfunc)( (char *)result+i*datasize*count,count, 1))<0)
          {
          pvm_freebuf(pvm_setrbuf(rbuf)); /* restore user's receive buf */
          goto done;
          }

        } /* end if (i == myginst) */

      } /* end for-loop */

    pvm_freebuf(pvm_setrbuf(rbuf)); /* restore user's receive buf */
    }
  else  
    {    /* everyone except the root sends data to the root */
    sbuf = pvm_mkbuf(PvmDataDefault);
    sbuf = pvm_setsbuf(sbuf);
 
    if ( (cc = (*packfunc)( data, count, 1)) < 0)
      {
      pvm_freebuf(pvm_setsbuf(sbuf)); /* restore user's send buf */
      goto done;
      }
    if ( (cc = pvm_send( roottid, msgtag)) < 0)
      {
      pvm_freebuf(pvm_setsbuf(sbuf)); /* restore user's send buf */
      goto done;
      }
    pvm_freebuf(pvm_setsbuf(sbuf)); /* restore user's send buf */

    }  /* end if-else */


  cc = PvmOk;

done:
  if (tids) free(tids);
  
  if (cc < 0) 
    {
    pvm_errno = cc;
    pvm_perror("pvm_gather");
    }

  if (x) 
    {
    if (TEV_DO_TRACE(TEV_GATHER1)) 
      {
      pvm_pkint(&cc, 1, 1);
      TEV_FIN;
      }
    pvmtoplvl = 1;
    }
  
  return(cc);

}  /* end pvm_gather() */






/*    
  int info = pvm_scatter(void *result, int *data,  int count, int datatype, 
                         void msgtag, char *gname, int rootinst)

  Performs a scatter of messages from the specified root member of the
  group to each of the members of the group.

  Each member of the group 'gname' receives a message 'result' 
  of type 'datatype' and length 'count' from the root member of the group.
  The root sends these messages from a single array 'data'
  which is of length, at least, (number of group members)*'count'.
  The values sent to the ith member of the group are
  taken from the 'data' array starting at position i*'count'.
  The root member of the group is specified by its instance number,
  'rootginst', in that group.
*/
 



int 
pvm_scatter(result, data, count, datatype, msgtag, gname, rootinst)
void *result, *data;
int  count, datatype, msgtag, rootinst;
char *gname;
{
  int mytid, roottid, myginst, datasize, gsize, *tids = 0, i, cc;
  int sbuf, rbuf;

  int (*packfunc)(), (*unpackfunc)();  /* ptrs to pack and unpack functions */
  int x;

  if (x = pvmtoplvl) 
    {
    pvmtoplvl = 0;
    if (TEV_DO_TRACE(TEV_SCATTER0)) 
      {
      pvm_pkstr(gname ? gname : "");
      pvm_pkint(&msgtag, 1, 1);
      TEV_FIN;
      }
    }

  if ( (result == NULL) || (count <= 0) ) /* check some parameters */
    {
    cc = PvmBadParam;
    goto done;
    }

  /* set up pointers to the appropriate pack and unpack routines */
  if ( (cc = gs_pack_unpack(datatype, &packfunc, &unpackfunc)) < 0)
    goto done;

  /* root must be member of the group */
  if ( (roottid = pvm_gettid(gname,rootinst)) < 0 )
    {
    cc = roottid;
    goto done;
    }

  mytid = pvm_mytid();

  /* get instance number - caller must be in group */
  if ( (myginst = pvm_getinst(gname, mytid)) < 0 )
    {
    cc = myginst;
    goto done;
    }

  /* I am the root node for the scatter operation */
  if (myginst == rootinst)
    {
    if ( data == NULL) /* check data parameter */
      {
      cc = PvmBadParam;
      goto done;
      }

    /* get the number of bytes per element of type datatype */
    if ( (datasize = gs_get_datasize(datatype)) < 0  ) 
      {
      cc = datasize;
      goto done;
      }

    /* Get the list of tids.  These must be contiguous (no holes). */
    if ( (cc = gs_get_tidlist(gname, msgtag, &gsize, &tids, 1)) < 0)
      goto done;

    sbuf = pvm_mkbuf(PvmDataDefault);

    /* The root sends values to everyone, except itself, in the group.
       For itself, the root copies the data into its result array.
    */
    for (i=0; i<gsize; i++)
      {
      if (i == myginst)
        BCOPY((char *) data + i*datasize*count, (char *) result,
              datasize*count);
      else
        {
        sbuf = pvm_initsend(PvmDataDefault);
        if ( (cc = (*packfunc)( (char *) data + i*datasize*count, count, 1))<0)
          {
          pvm_freebuf(pvm_setsbuf(sbuf)); /* restore user's send buf */
          goto done;
          }
        if ( (cc = pvm_send( tids[i], msgtag)) < 0)
          {
          pvm_freebuf(pvm_setsbuf(sbuf)); /* restore user's send buf */
          goto done;
          }

        } /* end if-else */

      } /* end for-loop */

    pvm_freebuf(pvm_setsbuf(sbuf)); /* restore user's send buf */
    }
  else
    {
    /* everyone receives a result from the root, except the root */
    rbuf = pvm_setrbuf(0);
    if ( (cc = pvm_recv( roottid, msgtag )) < 0)
      {
      pvm_freebuf(pvm_setrbuf(rbuf)); /* restore user's receive buf */
      goto done;
      }
    if ( (cc = (*unpackfunc)( result, count, 1)) < 0)
      {
      pvm_freebuf(pvm_setrbuf(rbuf)); /* restore user's receive buf */
      goto done;
      }
    pvm_freebuf(pvm_setrbuf(rbuf)); /* restore user's receive buf */

    }  /* end if-else */
	
  cc = PvmOk;

done:
  if (tids) free(tids);
  
  if (cc < 0) 
    {
    pvm_errno = cc;
    pvm_perror("pvm_scatter");
    }

  if (x) 
    {
    if (TEV_DO_TRACE(TEV_SCATTER1)) 
      {
      pvm_pkint(&cc, 1, 1);
      TEV_FIN;
      }
    pvmtoplvl = 1;
    }
  
  return(cc);

}  /* end pvm_scatter() */






/*    
  int info = gs_get_datasize(int datatype)

  Returns the size in bytes of a single element of type datatype.
*/




int 
gs_get_datasize(datatype)
int datatype;
{

  switch (datatype)
    {
    case (PVM_STR):
    case (PVM_BYTE):
      return(sizeof(char));
    case (PVM_SHORT):
      return(sizeof(short));
    case (PVM_INT):
      return(sizeof(int));
    case (PVM_LONG):
      return(sizeof(long));
    case (PVM_FLOAT):
      return(sizeof(float));
    case (PVM_DOUBLE):
      return(sizeof(double));
    case (PVM_CPLX):
      return(2*sizeof(float));
    case (PVM_DCPLX):
      return(2*sizeof(double));
    default:
      return(PvmBadParam);
    }  /* end switch (datatype) */

}  /* end gs_get_datasize() */





/*

*/
int 
gs_get_tidlist(group, msgtag, ntids, tids, holes_not_allowed)
char *group;
int msgtag, *ntids, **tids, holes_not_allowed;
{
  int sbuf, rbuf;
  int mytid;

  if ( group == (char*)0 ) return(PvmNullGroup);

  /* find out the server's tid, start the server if need be */
  if ( (gstid = gs_getgstid()) < 0 ) return(PvmSysErr);

  /* send the group name to the server */
  sbuf = pvm_mkbuf(PvmDataDefault);
  sbuf = pvm_setsbuf(sbuf);
  pvm_pkstr(group);
  if (holes_not_allowed)  
    pvm_send(gstid, TIDLIST); /* e.g. scatter, gather */
  else 
    pvm_send(gstid, BCAST);   /* e.g. bcast */
  
  /* get the list of tids back from the server */
  rbuf = pvm_setrbuf(0);
  if (holes_not_allowed)  
    pvm_recv(gstid, TIDLIST); /* e.g. scatter, gather */
  else 
    pvm_recv(gstid, BCAST);   /* e.g. bcast */
  
  pvm_upkint(ntids, 1, 1);
  
  /* check for number of tids group */
  if (*ntids < 0) 
    {
    pvm_freebuf(pvm_setsbuf(sbuf));
    pvm_freebuf(pvm_setrbuf(rbuf));
    return(*ntids);
    }
  
  /* if there is no one in the group */
  if (*ntids == 0) 
    {
    pvm_freebuf(pvm_setsbuf(sbuf));
    pvm_freebuf(pvm_setrbuf(rbuf));
    return(PvmNoInst);
    }


  /* make room for the tids */
  if ((*tids = (int *)malloc((*ntids) * sizeof(int))) == 0) 
    {
    pvm_freebuf(pvm_setsbuf(sbuf));
    pvm_freebuf(pvm_setrbuf(rbuf));
    return(PvmSysErr);
    }

  pvm_upkint(*tids, *ntids, 1);

  /* restore the users mbufs */
  pvm_freebuf(pvm_setsbuf(sbuf));
  pvm_freebuf(pvm_setrbuf(rbuf));

  return(PvmOk);

} /* end gs_get_tidlist() */
