/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:03 */ /*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */ #include #include "fcrt.h" #include "csortp.h" #include void /*FUNCTION*/ csortp( char *c, int c_s, long m, long n, long k, long l, long p[]) { #define C(I_,J_) (c+(I_)*(c_s)+(J_)) long int cl; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const P = &p[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. *>> 2008-10-29 CSORTP Krogh Moved the string.h line up. *>> 2005-12-06 CSORTP Krogh Added include of string.h for C version. *>> 1996-04-27 CSORTP Krogh Changes to use .C. and C%%. *>> 1996-01-19 CSORTP Krogh Changes to automate conversion to C. *>> 1995-11-09 CSORTP Krogh Got rid of Mult. entries and SFTRAN. *>> 1994-11-14 CSORTP Krogh Declared all vars. *>> 1992-11-23 CSORTP Snyder Add entry CSORTQ. *>> 1991-04-02 CSORTP Snyder Repair no permutation vector if m-n < 10 *>> 1988-11-22 CSORTP Snyder Initial code. * * Sort the M:N-vector of character strings C according to the (K:L) * substring of each element. C is not disturbed. P is set * so that C(P(J)) is the J'th element of the sorted sequence. * Enter at CSORTQ to use pre-specified permutation vector. * */ /* ***** 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. * CR is the current right bound of the unsorted sub-array. * PARTN is the partition element. * PTEMP holds elements of P during exchanges. * 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 ****************************** * */ for (cl = m; cl <= n; cl++) { P[cl] = cl; } csortq( c,c_s, m, n, k, l, p ); return; #undef C } /* end of function */ /*++ CODE for .C. is active */ #include void /*FUNCTION*/ csortq( char *c, int c_s, long m, long n, long k, long l, long p[]) { #define C(I_,J_) (c+(I_)*(c_s)+(J_)) long int bl, br, cl, cr, partn, ptemp, stackl[32], stackr[32], stktop; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const P = &p[0] - 1; long *const Stackl = &stackl[0] - 1; long *const Stackr = &stackr[0] - 1; /* end of OFFSET VECTORS */ /*++ END */ /*++ CODE for .C. is active */ long size = l - k + 1L; /* Length of char string to be compared. */ long km1 = k - 1L; if (n - m >= 10) { /*++ END */ stktop = 1; Stackl[1] = m; Stackr[1] = n; L_20: ; bl = Stackl[stktop]; br = Stackr[stktop]; stktop -= 1; partn = P[bl]; /* Choose a partitioning element. Use the median of the first, * middle and last elements. Sort them so the extreme elements * can serve as sentinels during partitioning. */ cl = (bl + br)/2; ptemp = P[cl]; if( strncmp(C(p[bl-1]-1,km1), C(ptemp-1,km1),size ) > 0 ){ P[cl] = P[bl]; /* if (C(P(BL))(K:L) .gt. C(PTEMP)(K:L)) then */ P[bl] = ptemp; ptemp = P[cl]; /*++ CODE for ~.C. is inactive * end if * if (C(P(BL))(K:L) .gt. C(P(BR))(K:l)) then *++ CODE for .C. is active */ } if( strncmp(C(p[bl-1]-1,km1), C(p[br-1]-1,km1), size) > 0 ){ cr = P[bl]; /*++ END */ P[bl] = P[br]; P[br] = cr; /*++ CODE for ~.C. is inactive * end if * if (C(PTEMP)(K:L) .gt. C(P(BR))(K:L)) then *++ CODE for .C. is active */ } if( strncmp(C(ptemp-1,km1), C(p[br-1]-1,km1),size) > 0 ){ P[cl] = P[br]; /*++ END */ P[br] = ptemp; ptemp = P[cl]; } P[cl] = P[br - 1]; /* end if */ P[br - 1] = ptemp; partn = P[cl]; /* 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. */ cl = bl; cr = br - 1; L_30: ; L_40: cl += 1; /*++ CODE for ~.C. is inactive * if (C(P(CL))(K:L) .lt. C(PARTN)(K:L)) go to 40 * 50 CR = CR-1 * if (C(P(CR))(K:L) .gt. C(PARTN)(K:L)) go to 50 *++ CODE for .C. is active */ if( strncmp(C(p[cl-1]-1,km1), C(partn-1,km1),size) < 0 ) goto L_40; L_50: cr -= 1; if( strncmp(C(p[cr-1]-1,km1), C(partn-1,km1),size) > 0 ) goto L_50; if (cl > cr) goto L_60; /*++ END */ ptemp = P[cl]; P[cl] = P[cr]; P[cr] = ptemp; goto L_30; L_60: ; /* 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). */ if (cl - bl > br - cr) { if (cl - bl > 10) { stktop += 1; Stackl[stktop] = bl; Stackr[stktop] = cr; } if (br - cr > 10) { stktop += 1; Stackl[stktop] = cl; Stackr[stktop] = br; } } else { if (br - cr > 10) { stktop += 1; Stackl[stktop] = cl; Stackr[stktop] = br; } if (cl - bl > 10) { stktop += 1; Stackl[stktop] = bl; Stackr[stktop] = cr; } } if (stktop != 0) goto L_20; } /* Clean up small subfiles using insertion sort on everything. */ for (cr = m + 1; cr <= n; cr++) { ptemp = P[cr]; cl = cr; L_70: ; if( strncmp(C(p[cl-2]-1,km1), C(ptemp-1,km1),size) > 0 ){ P[cl] = P[cl - 1]; /* if (C(P(CL-1))(K:L) .gt. C(PTEMP)(K:L)) then */ cl -= 1; if (cl > m) goto L_70; } P[cl] = ptemp; /* end if */ } return; #undef C } /* end of function */