/*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 <math.h>
#include "fcrt.h"
#include "csort.h"
#include <string.h>
#include <stdlib.h>
/*++ 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 */