/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:33:14 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv pf=,p_exsort s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include <stdio.h>
#include <stdlib.h>
#include "p_exsort.h"
/*>>   1996-06-24  DREXSORT  Krogh   Added code for conversion to C.
 *>>   1995-05-28  DREXSORT  Krogh   Converted SFTRAN to Fortran
 *>>   1990-02-09  DREXSORT  Snyder  Initial code.
 *
 *     Test driver for EXSORT.
 *
 *     Sort LDATA=10000 random numbers using EXSORT.
 *     Check whether they are in order.
 * */
		/* PARAMETER translations */
#define	LENBUF	1000
#define	OPTION	1
		/* end of PARAMETER translations */
 
	/* COMMON translations */
struct t_rcom {
	float r[LENBUF-(1)+1];
	}	rcom;
	/* end of COMMON translations */
 
int main( )
{
	long int l[LENBUF-(1)+1], outfil;
 
 
	exsort( dataop, LENBUF, l, OPTION, &outfil );
	exit(0);
} /* end of function */
 
		/* PARAMETER translations */
#define	LDATA	10000
		/* end of PARAMETER translations */
 
void /*FUNCTION*/ dataop(
long iop,
long i,
long j,
long *iflag)
{
	static LOGICAL32 isopen[4]={FALSE,FALSE,FALSE,FALSE};
	static long ncomp = 0;
	static long ndata = 0;
	static LOGICAL32 ok = TRUE;
	static float prev = -1.;
		/* OFFSET Vectors w/subscript range: 1 to dimension */
	LOGICAL32 *const Isopen = &isopen[0] - 1;
		/* end of OFFSET VECTORS */
 
	/*++ CODE for .C. is active */
 static float end_of_seq[1] = {-1.0e0};
 static char *fname[4]={"scratch1","scratch2","scratch3","scratch4"};
 static FILE *fp[4];
	switch (iop)
	{
		case 1: goto L_10;
		case 2: goto L_20;
		case 3: goto L_30;
		case 4: goto L_40;
		case 5: goto L_50;
		case 6: goto L_60;
		case 7: goto L_70;
		case 8: goto L_80;
	}
	/*++ END
	 * */
	return;
	/*      case 1 @ initial input into record J */
L_10:
	;
	ndata += 1;
	if (ndata <= LDATA)
	{
		rcom.r[j-(1)] = sranu();
		*iflag = 0;
	}
	else
	{
		*iflag = 1;
	}
	return;
	/*      case 2 @ write scratch from J onto file I */
L_20:
	;
      fwrite( &rcom.r[j-1], sizeof(rcom.r[0]), 1L, fp[i-1]);
	return;
	/*         write (i+10) r(j)
	 *      case 3 @ write end-of-sequence onto file I */
L_30:
	;
      fwrite( end_of_seq, sizeof(rcom.r[0]), 1L, fp[i-1]);
	return;
	/*         write (i+10) -1.0E0
	 *      case 4 @ read scratch into J from file I */
L_40:
	;
      fread( &rcom.r[j-1], sizeof(rcom.r[0]), 1L, fp[i-1]);
	*iflag = 0;
	/*         read (i+10) r(j) */
	if (rcom.r[j-(1)] < 0.0)
		*iflag = 1;
	return;
	/*      case 5 @ rewind file I */
L_50:
	;
	if (!Isopen[i])
	{
         fp[i-1] = fopen(fname[i-1], "wb+");
		Isopen[i] = TRUE;
		/*            open (i+10, status='scratch',form='unformatted') */
	}
      rewind( fp[i-1] );
	return;
	/*         rewind (i+10)
	 *      case 6 @ output from record J */
L_60:
	;
	if (i != 0)
	{
		if (ok)
		{
			printf(" EXSORT succeeded using%7ld compares\n", ncomp);
		}
		else
		{
			printf("EXSORT failed\n");
		}
	}
	else
	{
		if (rcom.r[j-(1)] < prev)
			ok = FALSE;
		prev = rcom.r[j-(1)];
	}
	return;
	/*      case 7 @ move record I to record J */
L_70:
	;
	rcom.r[j-(1)] = rcom.r[i-(1)];
	return;
	/*      case 8 @ iflage I and J */
L_80:
	;
	ncomp += 1;
	switch (SARITHIF(rcom.r[i-(1)] - rcom.r[j-(1)]))
	{
		case -1: goto L_110;
		case  0: goto L_120;
		case  1: goto L_130;
	}
L_110:
	*iflag = -1;
	return;
L_120:
	*iflag = 0;
	return;
L_130:
	*iflag = 1;
	return;
 
} /* end of function */