/*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 "csort.h" #include #include /*++ CODE for ~.C. is inactive * subroutine CSORT (C, M, N, K, L, CTEMP) *++ CODE for .C. is active */ void /*FUNCTION*/ csort( char *c, int c_s, long m, long n, long k, long l) { #define C(I_,J_) (c+(I_)*(c_s)+(J_)) long int bl, br, cl, cr, partn, stackl[32], stackr[32], stktop; /* OFFSET Vectors w/subscript range: 1 to dimension */ long *const Stackl = &stackl[0] - 1; long *const Stackr = &stackr[0] - 1; /* end of OFFSET VECTORS */ /*++ END * Copyright (c) 1996 California Institute of Technology, Pasadena, CA. * ALL RIGHTS RESERVED. * Based on Government Sponsored Research NAS7-03001. *>> 1996-04-27 CSORT Krogh Changes to use .C. and C%%. *>> 1996-01-19 CSORT Krogh Changes to automate conversion to C. *>> 1995-11-17 CSORT Krogh Changes for C conversion, SFTRAN => F77. *>> 1994-11-14 CSORT Krogh Declared all vars. *>> 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. * */ /* ***** 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. * 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. * */ long size = l - k + 1L; /* Length of char strings */ long km1 = k - 1L; char *ctemp; ctemp = (char*)malloc(c_s+1);/*Temp space for swapping strings.*/ if (n - m >= 10) { /* character*(*) CTEMP * * ***** Executable Statements ****************************** * */ stktop = 1; Stackl[1] = m; Stackr[1] = n; L_10: ; bl = Stackl[stktop]; br = Stackr[stktop]; stktop -= 1; /* 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)/2; /*++ CODE for ~.C. is inactive */ /* if (c(bl)(k:l).gt.c(cl)(k:l)) then * ctemp=c(cl) * c(cl)=c(bl) * c(bl)=ctemp * end if * if (c(bl)(k:l).gt.c(br)(k:l)) then * ctemp=c(bl) * c(bl)=c(cl) * c(cl)=ctemp * end if * if (c(cl)(k:l).gt.c(br)(k:l)) then * ctemp=c(cl) * c(cl)=c(bl) * c(bl)=ctemp * end if * partn=cl * ctemp=c(br-1) * c(br-1)=c(cl) * c(cl)=ctemp *++ CODE for .C. is active */ if( strncmp(C(bl - 1L,km1), C(cl - 1L,km1),size ) > 0 ){ strncpy( ctemp, C(cl - 1L,0), c_s ); strncpy( C(cl - 1L,0), C(bl - 1L,0), c_s ); strncpy( C(bl - 1L,0), ctemp, c_s ); } if( strncmp(C(bl - 1L,km1), C(br - 1L,km1),size) > 0 ){ strncpy( ctemp, C(bl - 1L,0), c_s ); strncpy( C(bl - 1L,0), C(cl - 1L,0), c_s ); strncpy( C(cl - 1L,0), ctemp, c_s ); } if( strncmp(C(cl - 1L,km1), C(br - 1L,km1),size) > 0 ){ strncpy( ctemp, C(cl - 1L,0), c_s ); strncpy( C(cl - 1L,0), C(bl - 1L,0), c_s ); strncpy( C(bl - 1L,0), ctemp, c_s ); } partn = cl; strncpy( ctemp, C(br - 2L,0), c_s ); strncpy( C(br - 2L,0), C(cl - 1L,0), c_s ); strncpy( C(cl - 1L,0), ctemp, c_s ); cl = bl; /*++ END * 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. */ cr = br - 1; L_20: ; L_30: cl += 1; /*++ CODE for ~.C. is inactive * if (c(cl)(k:l) .lt. c(partn)(k:l)) go to 30 * 40 cr=cr-1 * if (c(cr)(k:l) .gt. c(partn)(k:l)) go to 40 * if (cl.gt.cr) go to 50 * ctemp=c(cl) * c(cl)=c(cr) * c(cr)=ctemp *++ CODE for .C. is active */ if( strncmp(C(cl-1,km1), C(partn-1,km1), size) < 0 ) goto L_30; L_40: cr -= 1; if( strncmp(C(cr-1,km1), C(partn-1,km1), size) > 0 ) goto L_40; if (cl > cr) goto L_50; strncpy( ctemp, C(cl - 1L,0), c_s ); strncpy( C(cl - 1L,0), C(cr - 1L,0), c_s ); strncpy( C(cr - 1L,0), ctemp, c_s ); if (partn == cl) partn = cr; /*++ END */ goto L_20; L_50: ; /* 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_10; } /* Clean up small subfiles using insertion sort on everything. */ for (cr = m + 1; cr <= n; cr++) { cl = cr; /*++ CODE for ~.C. is inactive * ctemp=c(cr) * 60 if (c(cl-1)(k:l).gt.ctemp(k:l)) then * c(cl)=c(cl-1) * cl=cl-1 * if (cl .gt. m) go to 60 * end if * c(cl)=ctemp *++ CODE for .C. is active */ strncpy( ctemp, C(cr-1,0), c_s ); L_60: ; if( strncmp(C(cl-2,k-1), ctemp+(short)(k-1),size) > 0 ){ strncpy( C(cl-1,0), C(cl-2,0), c_s ); cl -= 1; if (cl > m) goto L_60; } strncpy( C(cl-1,0), ctemp, c_s ); } /*++ END */ return; #undef C } /* end of function */