/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:07 */
/*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 "insrtx.h"
#include <stdlib.h>
/*++ CODE for INSORT_VER = INSRTX is active */
/* PARAMETER translations */
#define MXSORT 32
#define NHEADS (2*MXSORT)
/* end of PARAMETER translations */
void /*FUNCTION*/ insrtx(
void (*compar)(long,long,long,long*),
long n,
long list[],
long *list1)
{
long int direct, heads[NHEADS], i, i1, i2, ip1, j1, j2, jhead,
length[NHEADS], m, myn, nchain, ncomp, nhead, phase;
/* OFFSET Vectors w/subscript range: 1 to dimension */
long *const Heads = &heads[0] - 1;
long *const Length = &length[0] - 1;
long *const List = &list[0] - 1;
/* end of OFFSET VECTORS */
/*++ CODE for INSORT_VER = INSORT is inactive
* subroutine INSORT (COMPAR,N,LIST,LIST1)
* integer COMPAR
*++ End
* Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
* ALL RIGHTS RESERVED.
* Based on Government Sponsored Research NAS7-03001.
*>> 1996-04-30 INSORT Krogh Changes to use .C. and C%%.
*>> 1996-03-30 INSORT Krogh IABS => ABS
*>> 1995-11-16 INSORT Krogh Setup for separate INSORT/INSRTX.
*>> 1994-11-11 INSORT Krogh Declared all vars.
*>> 1990-02-08 INSORT WV Snyder at JPL 91109, adapted for MATH77
* 5 February 1990.
*
* General sort routine.
*
* If INSORT is invoked, COMPAR is a 2-argument INTEGER function
* having a negative value if the record referenced by the first
* argument is to be sorted before the record referenced by the
* second argument, a zero value if the order is immaterial, and a
* positive value otherwise.
*
* If INSRTX is invoked, COMPAR is a 4-argument subroutine, invoked
* by CALL COMPAR (8,I,J,IORDER). IORDER should be negative if the
* record referenced by I should be sorted before the record refer-
* enced by J, a zero value if the order is immaterial, and a posi-
* tive value otherwise. INSRTX is used by the external sorting
* subroutine EXSORT.
*
* Since INSORT deals with record indices only, the sort keys may be
* arbitrarily complex, and the records to be sorted need not be
* in memory.
*
* LIST is at least N words long, where N is the number of records
* to be sorted. LIST defines the ordering of the sorted records
* when INSORT is finished. Let K=LIST(I). Then if K=0, record I
* is the last record of the sorted data set. Otherwise, record K
* is the immediate successor to record I.
*
* LIST1 is the first sorted record.
*
* Usage:
* external COMPAR
* call INSORT (COMPAR,N,LIST,LIST1)
* do while (LIST1.NE.0)
* do any processing for record LIST1 here.
* LIST1=LIST(LIST1)
* end while
* */
/* ***** Local Variables ************************************
*
* DIRECT is the length of a string, and the sign indicates the
* direction of initially detected order: 0 = none, positive =
* increasing, negative = decreasing.
* HEADS(2*I-1) and HEADS(2*I) hold heads of strings of length between
* 2**(I-1) and 2**I - 1.
* LENGTH contains the lengths of the strings indexed by the corres-
* ponding element of HEADS.
* MXSORT is log base 2 of the maximum sort capacity.
* MYN is the local value of N.
* NHEADS is 2 * log base 2 of the maximum sort capacity. */
/* ***** Executable Statements *****************************
*
* Scan records and detect ascending or descending chains of
* existing ordering.
* */
myn = n;
jhead = myn;
phase = 0;
nhead = 0;
ip1 = 1;
for (i = 1; i <= 32; i++)
{
Heads[i] = 0;
}
/* Indicate beginning of chain - no order assigned yet. */
L_40:
direct = 0;
/* Assume a forward chain will be found. */
jhead = ip1;
L_50:
i = ip1;
ip1 = i + 1;
if (ip1 > myn)
switch (IARITHIF(direct))
{
case -1: goto L_150;
case 0: goto L_160;
case 1: goto L_160;
}
/* Check sequence of two adjacent records.
*
*++ CODE for ~.C. & (INSORT_VER = INSORT) is inactive
* ncomp=compar(i,ip1)
*++ CODE for .C. & (INSORT_VER = INSORT) is inactive
*%% ncomp = (*compar)( i, ip1 );
*++ CODE for ~.C. & (INSORT_VER = INSRTX) is inactive
* call compar(8,i,ip1,ncomp)
*++ CODE for .C. & (INSORT_VER = INSRTX) is active */
(*compar)( 8, i, ip1, &ncomp );
switch (IARITHIF(ncomp))
{
case -1: goto L_100;
case 0: goto L_90;
case 1: goto L_120;
}
/*++ End */
L_90:
switch (IARITHIF(direct))
{
case -1: goto L_140;
case 0: goto L_110;
case 1: goto L_110;
}
/* Records I,I+1 are in ascending sequence.
* */
L_100:
if (direct < 0)
goto L_150;
/* Forward chain.
* */
L_110:
direct += 1;
List[i] = ip1;
goto L_50;
/* Records I,I+1 are in descending sequence.
* */
L_120:
switch (IARITHIF(direct))
{
case -1: goto L_140;
case 0: goto L_130;
case 1: goto L_160;
}
/* Start a backward chain.
*
* Indicate end of chain. */
L_130:
List[i] = 0;
/* Continue a backward chain.
* */
L_140:
direct -= 1;
List[ip1] = i;
goto L_50;
/* Had a chain, got a sequence change.
* */
L_150:
jhead = i;
goto L_170;
/* Indicate end of chain */
L_160:
List[i] = 0;
/* Compute log base 2 of ABS(direct). */
L_170:
direct = labs( direct ) + 1;
L_180:
m = 1;
phase = -phase;
for (i = 1; i <= MXSORT; i++)
{
if (m >= direct)
goto L_200;
m += m;
}
i = MXSORT;
L_200:
m = i + i;
L_220:
if (Heads[m - 1] != 0)
{
if (Heads[m] != 0)
{
j1 = Heads[m - 1];
j2 = Heads[m];
i1 = Length[m - 1];
i2 = Length[m];
/* Merge two shortest strings of three in the bucket. */
if (direct < i2)
{
j2 = jhead;
jhead = Heads[m];
i2 = direct;
direct = Length[m];
}
Heads[m - 1] = jhead;
Length[m - 1] = direct;
direct = i1 + i2;
nhead -= 1;
goto L_310;
}
if (direct > Length[m - 1])
{
m += 1;
}
else
{
Heads[m] = Heads[m - 1];
Length[m] = Length[m - 1];
}
}
Heads[m - 1] = jhead;
Length[m - 1] = direct;
nhead += 1;
if (ip1 <= myn)
goto L_40;
if (nhead == 1)
{
*list1 = jhead;
return;
}
for (m = 1; m <= NHEADS; m++)
{
if (Heads[m] != 0)
goto L_290;
}
L_290:
j1 = Heads[m];
direct = Length[m];
Heads[m] = 0;
L_300:
m += 1;
if (Heads[m] == 0)
goto L_300;
direct += Length[m];
nhead -= 2;
phase = -1;
/* Merge chains together.
* */
j2 = Heads[m];
L_310:
Heads[m] = 0;
nchain = 0;
L_320:
;
/*++ CODE for ~.C. & (INSORT_VER = INSORT) is inactive
* ncomp=compar(j1,j2)
*++ CODE for .C. & (INSORT_VER = INSORT) is inactive
*%% ncomp = (*compar)( j1, j2 );
*++ CODE for ~.C. & (INSORT_VER = INSRTX) is inactive
* call compar(8,j1,j2,ncomp)
*++ CODE for .C. & (INSORT_VER = INSRTX) is active */
(*compar)( 8, j1, j2, &ncomp );
if (ncomp > 0)
{
/*++ End
*
* J2 should come before J1.
* */
switch (IARITHIF(nchain))
{
case -1: goto L_380;
case 0: goto L_360;
case 1: goto L_370;
}
L_360:
jhead = j2;
goto L_380;
L_370:
List[i1] = j2;
L_380:
nchain = -1;
i2 = j2;
j2 = List[i2];
if (j2 != 0)
goto L_320;
List[i2] = j1;
}
else
{
/* J1 should come before J2.
* */
switch (IARITHIF(nchain))
{
case -1: goto L_400;
case 0: goto L_410;
case 1: goto L_420;
}
L_400:
List[i2] = j1;
goto L_420;
L_410:
jhead = j1;
L_420:
nchain = 1;
i1 = j1;
j1 = List[i1];
if (j1 != 0)
goto L_320;
List[i1] = j2;
}
if (phase < 0)
goto L_180;
m += 2;
goto L_220;
} /* end of function */