/*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 #include "fcrt.h" #include "insrtx.h" #include /*++ 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 */