/*Translated by FOR_C, v3.1, on 08/09/91 at 11:25:28 */ /*FOR_C Options SET: c=2 io=c op=i pf=work.h,mathc90.h,mathc90b.h s=dbov - prototypes */ /*>> 1993-03-31 CLL */ /*>> 1993-02-11 CLL */ #include /* strncmp() */ #include "fcrt.h" /* 1993-02-11 CLL. This is a character string sorting routine for the mathc90 library that does not correspond directly to any Fortran routine in MATH77. It is similar to the Fortran codes CSORT and CSORTP, but different in that it assumes the given data is "an array of pointers to char". This code was written by making substantial changes to C code produced by applying the converter to CSORT. Changed the type of c to "char *c[]". Deleted 6th argument: ctemp. Doing swaps by swapping pointers. Using standard function "strncmp()" rather than "f_strcmp". Deleted variables c_s and ctemp_s. Added variable nchars. */ void /*FUNCTION*/ csort1(char *c[], long m, long n, long k, long l) { char *ctemp; int nchars; #define C(I_) c[I_] long int bl, br, cl, cr, partn, stackl[32], stackr[32], stktop; /* . Copyright (C) 1989, California Institute of Technology. * . All rights reserved. U. S. Government sponsorship under * . NASA contract NAS7-918 is acknowledged. *>> 1988-11-22 CSORT Snyder Initial code. * * Sort the M:N-vector of character strings C according to the (K:L) * substring of each element. CTEMP is a temporary scalar character * string at least as long as an element of C. * 00001100 */ /* ***** Local Variables ************************************ * * BL is the left bound of the sub-array to be sorted at the next * step. * BR is the right bound of the sub array to be sorted at the next * step. * CL is the current left bound of the unsorted sub-array. 00002100 * CR is the current right bound of the unsorted sub-array. * CTEMP holds elements of C during exchanges. * PARTN is the subscript of the partition element. * STACKL keeps track of the left bounds of sub-arrays waiting to be * sorted. * STACKR keeps track of the right bounds of sub-arrays waiting to be * sorted. * STKTOP keeps track of the top of the stacks. * */ /* ***** Executable Statements ****************************** * */ nchars = l - k + 1; if (n - m >= 10L) { stktop = 1L; stackl[0L] = m; stackr[0L] = n; goto L_20006; L_20004: if (stktop == 0L) goto L_20005; L_20006: bl = stackl[stktop - 1L]; br = stackr[stktop - 1L]; stktop = stktop - 1L; /* Choose a partitioning element. Use the median of the first, * middle and last elements. Sort them so the extreme elements * serve as sentinels during partitioning. */ cl = (bl + br)/2L; if (strncmp(C(bl - 1L)+(short)(k - 1L), C(cl - 1L)+(short)(k - 1L),nchars) > 0) { ctemp = C(cl - 1L); C(cl - 1L) = C(bl - 1L); C(bl - 1L) = ctemp; } if (strncmp(C(bl - 1L)+(short)(k - 1L), C(br - 1L)+(short)(k - 1L),nchars) > 0) { ctemp = C(bl - 1L); C(bl - 1L) = C(cl - 1L); C(cl - 1L) = ctemp; } if (strncmp(C(cl - 1L)+(short)(k - 1L), C(br - 1L)+(short)(k - 1L),nchars) > 0) { ctemp = C(cl - 1L); C(cl - 1L) = C(bl - 1L), C(bl - 1L) = ctemp; } partn = cl; ctemp = C(br - 2L); C(br - 2L) = C(cl - 1L); C(cl - 1L) = ctemp; /* Partition the sub-array around PARTN. Exclude the above * considered elements from partitioning because they're al- * ready in the correct subfiles. Stop scanning on equality to * prevent files containing equal values from causing a loop. 00007100 */ cl = bl; cr = br - 1L; L_20013: goto L_20017; L_20015: if (strncmp(C(cl - 1L)+(short)(k - 1L), C(partn - 1L)+(short)(k - 1L),nchars) >= 0) goto L_20016; L_20017: cl = cl + 1L; goto L_20015; L_20016: goto L_20020; L_20018: if (strncmp(C(cr - 1L)+(short)(k - 1L), C(partn - 1L)+(short)(k - 1L),nchars) <= 0) goto L_20019; L_20020: cr = cr - 1L; goto L_20018; L_20019: if (cl > cr) goto L_20014; ctemp = C(cl - 1L); C(cl - 1L) = C(cr - 1L); C(cr - 1L) = ctemp; if (partn == cl) partn = cr; goto L_20013; /* Put sub-arrays on the stack if they're big enough. Put the * larger under the smaller, so the smaller will be done next. * This makes the upper bound of the stack depth log2 (n-m+1). * (The "Hibbard" modification of quicksort). 00009000 */ L_20014: if (cl - bl > br - cr) { if (cl - bl > 10L) { stktop = stktop + 1L; stackl[stktop - 1L] = bl; stackr[stktop - 1L] = cr; } if (br - cr > 10L) { stktop = stktop + 1L; stackl[stktop - 1L] = cl; stackr[stktop - 1L] = br; } } else { if (br - cr > 10L) { stktop = stktop + 1L; stackl[stktop - 1L] = cl; stackr[stktop - 1L] = br; } if (cl - bl > 10L) { stktop = stktop + 1L; stackl[stktop - 1L] = bl; stackr[stktop - 1L] = cr; } } goto L_20004; L_20005: ; } /* Clean up small subfiles using insertion sort on everything. */ for (cr = m + 1L; cr <= n; cr++) { ctemp = C(cr - 1L); cl = cr; L_20034: if (strncmp(C(cl - 2L)+(short)(k - 1L), ctemp+(short)(k - 1L),nchars) > 0) { C(cl - 1L) = C(cl - 2L); cl = cl - 1L; if (cl <= m) goto L_20035; goto L_20034; } L_20035: C(cl - 1L) = ctemp; } return; #undef C } /* end of function */