/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:54 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include "exsort.h"
#include <stdlib.h>
void /*FUNCTION*/ exsort(
void (*dataop)(long,long,long,long*),
long maxx,
long list[],
long option,
long *outfil)
{
long int end, head, i, iflag, j, kode, l, m, maxdat, maxind, maxstr,
minind, minstr, mx1, n, nbs, nstrng[4], outape, split, top;
/* EQUIVALENCE translations */
long _e1[2], _e0[4];
long int *const in = (long*)_e0;
long int *const in1 = (long*)_e0;
long int *const in2 = (long*)((long*)_e0 + 1);
long int *const in3 = (long*)((long*)_e0 + 2);
long int *const in4 = (long*)((long*)_e0 + 3);
long int *const out = (long*)_e1;
long int *const out1 = (long*)_e1;
long int *const out2 = (long*)((long*)_e1 + 1);
/* end of EQUIVALENCE translations */
/* OFFSET Vectors w/subscript range: 1 to dimension */
long *const In = &in[0] - 1;
long *const List = &list[0] - 1;
long *const Nstrng = &nstrng[0] - 1;
long *const Out = &out[0] - 1;
/* end of OFFSET VECTORS */
/* Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
* ALL RIGHTS RESERVED.
* Based on Government Sponsored Research NAS7-03001.
*>> 1996-05-15 EXSORT Krogh Changes to use .C. and C%%.
*>> 1995-11-17 EXSORT Krogh Convert SFTRAN to Fortran 77.
*>> 1990-02-07 EXSORT WV Snyder at JPL, 91109, Convert to SFtran */
/* DATAOP is a user-coded subroutine used to perform all operations on
* the data. The operations include acquiring data from outside of
* the EXSORT interface, manipulating scratch files and performing
* input and output on scratch files, moving data from one memory
* area to another, returning sorted data from the EXSORT interface
* to the user program, and comparing one datum with another.
*
* calling sequence for DATAOP:
* call DATAOP (IOP,I1,I2,IFLAG)
* where all arguments are integers,
* IOP defines the operation to be performed,
* I1 is usually an index (1-4) of a file upon which to operate,
* I2 is usually an index (1-maxx) of the data area to use.
* IFLAG is a flag to be set by DATAOP.
* the values of IOP and the corresponding required actions are
* detailed below.
*
* IOP ACTION
*
* 1 Place a datum from the set to be sorted in the record area indexed
* by I2. I1 is irrelevant. Set the value of IFLAG to zero if a
* datum is available. Set the value of IFLAG to any non-zero value
* if the entire data set has been provided by this avenue.
*
* 2 Write the datum in the record area indexed by I2 on the intermedi-
* ate scratch file indexed by I1. The value of IFLAG is irrelevant.
*
* 3 Place an end-of-string mark (eof, unique datum, etc), to be
* recognized during performance of operation 4 (below), on the
* intermediate scratch file indexed by I1. The values of I2 and
* IFLAG are irrelevant.
*
* 4 Read a datum from the intermediate scratch file indexed by I1 into
* the record area indexed by I2. Set the value of IFLAG to zero if
* a datum is available. Set the value of IFLAG to any non-zero
* value if an end-of-string mark created by operation 3 is detected.
*
* 5 Rewind the intermediate scratch file indexed by I1. The values of
* I2 and IFLAG are irrelevant.
*
* 6 If I1 is zero, a datum from the sorted data set is in the record
* area indexed by I2. If I1 is non-zero, the entire sorted data set
* has been provided by this avenue. The value of IFLAG is irrele-
* vant.
*
* 7 Move the datum in the record area indexed by I1 to the record area
* indexed by I2. The value of IFLAG is irrelevant.
*
* 8 Compare the datum in the record area indexed by I1 to the datum in
* the record area indexed by I2. Set IFLAG to some negative value
* if the datum in the record area indexed by I1 is to be sorted
* before the datum in the record area indexed by I2; set the value
* of IFLAG to zero if the order of the records is immaterial; set
* IFLAG to some positive number if the datum in the record area
* indexed by I1 is to be sorted after the datum in the record area
* indexed by I2.
*
* MAXX is the number of record areas available. The in-core sort will
* use MAXX, MAXX-1 or MAXX-2 record areas, so MAXX must be at least
* 4.
*
* LIST is the array used by INSORT for pointers. LIST must be at least
* MAXX words long.
*
* OPTION specifies the action to take if the data are initially ordered
* or at worst disordered in blocks of less than MAXX, but cannot be
* entirely sorted in core. If OPTION is zero and the data are init
* ially ordered, the value of OUTFIL will be the index of the file
* containing the ordered data. If OPTION is zero but the data are
* not initially ordered, the value of OUTFIL will be zero, and the
* data will have been passed via DATAOP (6,I1,I2,IFLAG). If OPTION
* is non-zero, the data will always be passed via DATAOP (6,...),
* and the value of OUTFIL will be irrelevant.
*
* ***** External References ********************************
*
* INSRTX sorts a block of data in memory. INSRTX is a special entry
* in INSORT that allows using DATAOP instead of INSORT's usual
* 2-argument compare routine.
* PVEC converts the list produced by INSRTX to a permutation vector.
* This is done to allow a binary search in the sorted data set.
*
*
* ***** Local Variables ************************************
* */
long int dum;
*outfil = 0;
/* integer DUM
*
* ***** Executable Statements ******************************
*
* Initialize.
* */
n = 0;
kode = 2;
maxdat = maxx - 1;
mx1 = maxx + 1;
nbs = 0;
minstr = 1;
maxstr = 2;
minind = maxx;
maxind = maxx - 1;
/* Fill the user's data area and sort it. If end-of-input does not
* occur, write the data on a scratch file and do a merge later,
* if necessary.
*
* Start forever block */
L_20:
;
if (n < maxdat)
{
n += 1;
(*dataop)( 1, 0, n, &end );
if (end == 0)
goto L_20;
/* call dataop (1,0,n,end) */
n -= 1;
if (n == 0)
{
if (nbs != 0)
{
if (nbs != 1)
goto L_200;
/* One block contained all the data. Emit the data from
* memory, instead of reading it from scratch. */
(*dataop)( 5, 1, 0, &dum );
kode = 6;
/* call dataop (5,1,0,dum)
* Ready for final output from memory */
outape = 0;
goto L_120;
}
(*dataop)( 6, 1, 0, &dum );
return;
/* call dataop (6,1,0,dum) */
}
}
insrtx( dataop, n, list, &head );
nbs += 1;
outape = minstr;
if (nbs == 1)
{
if (end != 0)
{
/* Ready for final output from memory */
kode = 6;
outape = 0;
}
else
{
for (i = 1; i <= 4; i++)
{
(*dataop)( 5, i, 0, &dum );
Nstrng[i] = 0;
/* call dataop (5,i,0,dum) */
}
Nstrng[1] = 1;
}
}
else
{
/* Another block has been sorted. See if it will fit on an
* existing string.
* */
iflag = -1;
if (Nstrng[2] != 0)
(*dataop)( 8, head, maxind, &iflag );
if (iflag < 0)
{
/* if (nstrng(2).ne.0) call dataop (8,head,maxind,iflag) */
(*dataop)( 8, head, minind, &dum );
}
else
{
/* call dataop (8,head,minind,iflag) */
outape = maxstr;
}
if (iflag < 0)
{
/* The sorted string won't fit on an existing string. Will
* part of it fit?
* */
pvec( list, head );
(*dataop)( 8, List[n], minind, &iflag );
if (iflag < 0)
{
/* call dataop (8,list(n),minind,iflag)
*
* None of the list will fit. Handle the list similarly
* to the part that won't fit.
* */
top = n;
}
else
{
/* Some of it will fit. Find out how much.
* */
i = 1;
j = n;
/* Start while block */
L_60:
if (j - i > 1)
{
split = (j + i)/2;
(*dataop)( 8, List[split], minind, &iflag );
if (iflag >= 0)
{
/* call dataop (8,list(split),minind,iflag) */
j = split;
}
else
{
i = split;
}
goto L_60;
/* End while block */
}
split = j;
/* Write the part that will fit on intermediate scratch.
* */
for (j = split; j <= n; j++)
{
(*dataop)( 2, minstr, List[j], &dum );
;
}
/* call dataop (2,minstr,list(j),dum) */
(*dataop)( 7, List[n], minind, &dum );
top = split - 1;
/* call dataop (7,list(n),minind,dum) */
}
if (Nstrng[2] != 0)
{
/* Determine which intermediate scratch file to use for
* the part that won't fit. The rule is to use the file
* with the least strings. If the number of strings is
* the same, use the file with the maximum final datum.
* */
if (Nstrng[1] != Nstrng[2])
{
if (Nstrng[outape] >= Nstrng[3 - outape])
outape = 3 - outape;
}
else
{
outape = maxstr;
}
(*dataop)( 3, outape, 0, &dum );
}
else
{
/* call dataop (3,outape,0,dum)
*
* If we are writing the first string on file 2, we must
* decrease the available space for sorting.
* */
outape = 2;
maxdat -= 1;
}
Nstrng[outape] += 1;
/* Write the part that won't fit on intermediate scratch.
* */
for (j = 1; j <= top; j++)
{
(*dataop)( 2, outape, List[j], &dum );
;
}
/* call dataop (2,outape,list(j),dum) */
top = List[top];
/* The sorted block has been written on intermediate
* scratch.c */
goto L_200;
}
}
L_120:
m = head;
/* Start while block */
L_140:
if (m != 0)
{
/* Output the block */
(*dataop)( kode, outape, m, &iflag );
top = m;
/* call dataop (kode,outape,m,iflag) */
m = List[top];
goto L_140;
/* End while block */
}
/* End of Output the block */
if (outape == 0)
{
/* All done */
(*dataop)( 6, 1, 0, &dum );
return;
/* call dataop (6,1,0,dum) */
}
/* Continue with sort */
L_200:
;
/* Test END to see if we need to sort more or we exit the forever block. */
if (end != 0)
goto L_220;
(*dataop)( 7, top, mx1 - outape, &dum );
n = 0;
/* call dataop (7,top,mx1-outape,dum) */
if (Nstrng[2] != 0)
{
/* Determine MINSTR etc. */
(*dataop)( 8, minind, maxind, &iflag );
if (iflag >= 0)
{
/* call dataop (8,minind,maxind,iflag) */
i = maxstr;
maxstr = minstr;
minstr = i;
i = maxind;
maxind = minind;
minind = i;
}
}
goto L_20;
/* End forever block */
L_220:
;
/* All of the data have been block-sorted. Determine whether we
* need to do a merge.
* */
(*dataop)( 3, 1, 0, &dum );
(*dataop)( 5, 1, 0, &dum );
if (Nstrng[2] == 0)
{
/* call dataop (3,1,0,dum)
* call dataop (5,1,0,dum)
*
* All of the data are on scratch 1.
* See what the user wants to do.
* */
if (option == 0)
{
*outfil = 1;
return;
}
/* Start forever block */
L_240:
;
(*dataop)( 4, 1, 1, &iflag );
if (iflag != 0)
goto L_260;
/* call dataop (4,1,1,iflag) */
(*dataop)( 6, 0, 1, &dum );
goto L_240;
/* call dataop (6,0,1,dum)
* End forever block */
L_260:
;
(*dataop)( 5, 1, 0, &dum );
}
else
{
/* call dataop (5,1,0,dum)
*
* We must do a merge. Set some values, and then check what
* kind of output we do for this pass.
* */
(*dataop)( 3, 2, 0, &dum );
(*dataop)( 5, 2, 0, &dum );
*in1 = 1;
/* call dataop (3,2,0,dum)
* call dataop (5,2,0,dum)
* IN1 is to be the file with the most strings. */
if (Nstrng[1] < Nstrng[2])
*in1 = 2;
*in2 = 3 - *in1;
*out1 = 3;
*out2 = 4;
m = 2;
/* Start forever block */
L_280:
;
if (Nstrng[*in1] != 1)
{
i = *in1;
*in1 = *in2;
*in2 = i;
}
else
{
kode = 6;
*out1 = 0;
}
outape = 1;
/* Read one record from each file to start the merge. Sort
* these records. Then do the merge by writing the lowest
* record, reading a new record from the lowest file and
* re-ordering the records with a partial in-core merge.
*
* Start forever block */
L_300:
;
(*dataop)( 4, *in1, 1, &iflag );
(*dataop)( 4, *in2, 2, &iflag );
if (m != 2)
{
/* call dataop (4,in1,1,iflag)
* call dataop (4,in2,2,iflag) */
(*dataop)( 4, *in3, 3, &iflag );
if (m == 4)
(*dataop)( 4, *in4, 4, &iflag );
}
/* call dataop (4,in3,3,iflag)
* if (m .eq. 4) call dataop (4,in4,4,iflag)
* Sort set of first records from each file */
insrtx( dataop, m, list, &head );
/* Write current lowest record,and then read a new record
* from the same file.
*
* Start forever block */
L_320:
;
(*dataop)( kode, Out[outape], head, &dum );
(*dataop)( 4, In[head], head, &end );
i = List[head];
/* call dataop (kode,out(outape),head,dum)
* call dataop (4,in(head),head,end) */
if (end == 0)
{
/* if i=0, head is only remaining file */
if (i != 0)
{
(*dataop)( 8, head, i, &iflag );
if (iflag > 0)
{
/* call dataop (8,head,i,iflag)
*
* Head is no longer lowest. Merge it with
* chain.
* */
l = head;
head = i;
/* Start forever block */
L_340:
;
j = List[i];
if (j == 0)
goto L_360;
(*dataop)( 8, l, j, &iflag );
if (iflag <= 0)
goto L_360;
/* call dataop (8,l,j,iflag) */
i = j;
goto L_340;
/* End forever block */
L_360:
;
List[i] = l;
List[l] = j;
}
}
}
else
{
/* A string has terminated.
* */
l = In[head];
Nstrng[l] -= 1;
if (Nstrng[l] == 0)
(*dataop)( 5, l, 0, &dum );
if (i == 0)
goto L_380;
/* if (nstrng(l).eq.0) call dataop (5,l,0,dum) */
head = i;
}
goto L_320;
/* End forever block */
L_380:
;
/* All strings have terminated. If we are doing final
* output we are done.
* */
if (kode == 6)
goto L_420;
/* Determine whether to continue the current merge pass or
* start a new one.
* */
l = Out[outape];
Nstrng[l] += 1;
(*dataop)( 3, l, 0, &dum );
j = Nstrng[*in1] + Nstrng[*in2];
/* call dataop (3,l,0,dum) */
if (j == 2)
{
if (Nstrng[*out1] == 1)
{
/* The total remaining input string count is 2. The
* total output string count is 1 or 2. We will do
* final output with a merge order of 3 or 4
* depending on whether the total output string count
* is 1 or 2.
* */
*in3 = *out1;
m = 4;
(*dataop)( 5, *out1, 0, &dum );
if (Nstrng[*out2] != 0)
{
/* call dataop (5,out1,0,dum) */
m = 5;
*in4 = *out2;
(*dataop)( 5, *out2, 0, &dum );
}
/* call dataop (5,out2,0,dum) */
kode = 6;
*out1 = 0;
outape = 2;
}
}
else if (Nstrng[*in1] == 0)
{
goto L_400;
}
outape = 3 - outape;
m = max( m - 1, 2 );
goto L_300;
/* End forever block */
L_400:
;
/* We must start a new merge pass. Swap input and output
* files. If the total remaining input string count is 1,
* the merge order can be temporarily raised to 3.
* */
m = 2;
/* NSTRNG(IN2) is always .ge. NSTRNG(IN1). */
(*dataop)( 5, *out1, 0, &dum );
if (Nstrng[*out2] != 0)
{
/* call dataop (5,out1,0,dum) */
if (Nstrng[*in2] != 0)
{
m = 3;
*in3 = *in2;
}
(*dataop)( 5, *out2, 0, &dum );
i = *in2;
/* call dataop (5,out2,0,dum) */
*in2 = *out2;
*out2 = i;
}
i = *in1;
*in1 = *out1;
*out1 = i;
goto L_280;
/* End forever block */
L_420:
;
}
(*dataop)( 6, 1, 0, &dum );
return;
/* call dataop (6,1,0,dum) */
} /* end of function */