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