From 34d15c114ce69300fee59590ddf516b419c5230d Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Fri, 3 Jun 2022 12:35:14 -0400 Subject: [PATCH] Just brings the code for the new sorting. Intentionally have not yet changed the names to avoild name collision, nor included in the build system --- shared/new_sort/MAPL_Sort.F90 | 468 +++++++++++++++++++++++++++++++++ shared/new_sort/quicksort.c | 203 ++++++++++++++ shared/new_sort/sort.c | 126 +++++++++ shared/new_sort/swap_shuffle.c | 69 +++++ 4 files changed, 866 insertions(+) create mode 100644 shared/new_sort/MAPL_Sort.F90 create mode 100644 shared/new_sort/quicksort.c create mode 100644 shared/new_sort/sort.c create mode 100644 shared/new_sort/swap_shuffle.c diff --git a/shared/new_sort/MAPL_Sort.F90 b/shared/new_sort/MAPL_Sort.F90 new file mode 100644 index 00000000000..9928d79d176 --- /dev/null +++ b/shared/new_sort/MAPL_Sort.F90 @@ -0,0 +1,468 @@ + +#define ASSERT_(A) if(.not.(A))call exit(1) + + +! $Id: MAPL_Sort.F90,v 1.12 2014-12-11 21:08:00 atrayano Exp $ + +!============================================================================= +!BOP + +! !MODULE: MAPL_Sort -- A utility to sort integers + +! !INTERFACE: + +module MAPL_SortMod + + implicit none + private + +! !PUBLIC ROUTINES: + + public MAPL_Sort + +! !DESCRIPTION: +! +! {\tt MAPL\_Sort} is a utility to do a quicksort on integers. The general +! interface is: +!\bv +! subroutine MAPL_Sort(A[,Bi,Bl,Br,Bd,Ci,Cl,Cr,Cd,Di,Dl,Dr,Dd,DIM]) +! integer(kind=[4,8]), intent(INOUT) :: A(:) +! integer(kind=4) , optional, intent(INOUT) :: Bi(:,:) +! integer(kind=8) , optional, intent(INOUT) :: Bl(:,:) +! real (kind=4) , optional, intent(INOUT) :: Br(:,:) +! real (kind=8) , optional, intent(INOUT) :: Bd(:,:) +! integer(kind=4) , optional, intent(INOUT) :: Ci(:,:) +! integer(kind=8) , optional, intent(INOUT) :: Cl(:,:) +! real (kind=4) , optional, intent(INOUT) :: Cr(:,:) +! real (kind=8) , optional, intent(INOUT) :: Cd(:,:) +! integer(kind=4) , optional, intent(INOUT) :: Di(:,:) +! integer(kind=8) , optional, intent(INOUT) :: Dl(:,:) +! real (kind=4) , optional, intent(INOUT) :: Dr(:,:) +! real (kind=8) , optional, intent(INOUT) :: Dd(:,:) +! integer(kind=4), optional, intent(IN ) :: DIM +! +! subroutine MAPL_Sort(A[Ci,Cl,Cr,Cd,DIM]) +! integer(kind=[4,8]), intent(INOUT) :: A (:,:) +! integer(kind=4) , optional, intent(INOUT) :: Ci(:,:) +! integer(kind=8) , optional, intent(INOUT) :: Cl(:,:) +! real (kind=4) , optional, intent(INOUT) :: Cr(:,:) +! real (kind=8) , optional, intent(INOUT) :: Cd(:,:) +! integer(kind=4), optional, intent(IN ) :: DIM +! +!\ev +! {\tt MAPL\_Sort} sorts the key (contained in a row or column of A) +! in ascending order and reorders the data in B or in non-key rows or columns of A +! in the same order; i.e., it does the same exchanges as were done +! to the key in sorting it. If, for example, on input B(:) contains the ordered integers +! from 1 to size(A), on output it will contain the positions of the elements of +! the sorted A in the unsorted A. In the last two signatures, DIM is the dimension +! of A or B being reordered. In the last signature, for example, DIM=1 corresponds +! to a B ordered as B(size(A),:), whereas DIM=2 corresponds to B(:,size(A)). +! The default is DIM=2. The quicksort is coded in C and does not appear here. + +!EOP +!============================================================================= + +interface MAPL_Sort + module procedure SORTS + module procedure SORTSL + module procedure SORTSR + module procedure SORTSD + module procedure SORTL + module procedure SORTLL + module procedure SORTLR + module procedure SORTLD + module procedure SORT2AS + module procedure SORT2AL + + module procedure SORT2LS + module procedure SORT2LL + module procedure SORT2LR + module procedure SORT2LD + module procedure SORT2SS + module procedure SORT2SR + module procedure SORT2SL + module procedure SORT2SD +end interface + +contains + +subroutine SORTL(A,Bi,Bl,Br,Bd,Ci,Cl,Cr,Cd,Di,Dl,Dr,Dd,DIM) + integer(kind=8), intent(INOUT) :: A(:) + integer(kind=4), optional, intent(INOUT) :: Bi(:) + integer(kind=8), optional, intent(INOUT) :: Bl(:) + real (kind=4), optional, intent(INOUT) :: Br(:) + real (kind=8), optional, intent(INOUT) :: Bd(:) + integer(kind=4), optional, intent(INOUT) :: Ci(:,:) + integer(kind=8), optional, intent(INOUT) :: Cl(:,:) + real (kind=4), optional, intent(INOUT) :: Cr(:,:) + real (kind=8), optional, intent(INOUT) :: Cd(:,:) + integer(kind=4), optional, intent(INOUT) :: Di(:,:) + integer(kind=8), optional, intent(INOUT) :: Dl(:,:) + real (kind=4), optional, intent(INOUT) :: Dr(:,:) + real (kind=8), optional, intent(INOUT) :: Dd(:,:) + integer, optional, intent(IN ) :: DIM + + integer :: uDIM, sg, id, len + integer :: Dm(0,0) + + len = size(A) + + if (present(Bi)) then + call QSORTL44(A,Bi,Dm,len,1,0) + elseif(present(Bl))then + call QSORTL84(A,Bl,Dm,len,1,0) + elseif(present(Br))then + call QSORTL44(A,Br,Dm,len,1,0) + elseif(present(Bd)) then + call QSORTL84(A,Bd,Dm,len,1,0) + else + + if(present(DIM)) then + ASSERT_(DIM>0 .and. DIM<3) + uDIM = DIM + else + uDIM = 2 + end if + + if(uDIM==1) then + sg = -1 + id = 2 + else + sg = 1 + id = 1 + end if + + if (present(Ci)) then + if (present(Di)) then + call QSORTL44(A,Ci,Di,len,sg*size(Ci,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTL48(A,Ci,Dl,len,sg*size(Ci,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTL44(A,Ci,Dr,len,sg*size(Ci,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTL48(A,Ci,Dd,len,sg*size(Ci,id),sg*size(Dd,id)) + else + call QSORTL44(A,Ci,Dm,len,sg*size(Ci,id),0) + endif + elseif(present(Cl))then + if (present(Di)) then + call QSORTL84(A,Cl,Di,len,sg*size(Cl,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTL88(A,Cl,Dl,len,sg*size(Cl,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTL84(A,Cl,Dr,len,sg*size(Cl,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTL88(A,Cl,Dd,len,sg*size(Cl,id),sg*size(Dd,id)) + else + call QSORTL84(A,Cl,Dm,len,sg*size(Cl,id),0) + endif + elseif(present(Cr))then + if (present(Di)) then + call QSORTL44(A,Cr,Di,len,sg*size(Cr,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTL48(A,Cr,Dl,len,sg*size(Cr,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTL44(A,Cr,Dr,len,sg*size(Cr,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTL48(A,Cr,Dd,len,sg*size(Cr,id),sg*size(Dd,id)) + else + call QSORTL44(A,Cr,Dm,len,sg*size(Cr,id),0) + endif + elseif(present(Cd)) then + if (present(Di)) then + call QSORTL84(A,Cd,Di,len,sg*size(Cd,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTL88(A,Cd,Dl,len,sg*size(Cd,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTL84(A,Cd,Dr,len,sg*size(Cd,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTL88(A,Cd,Dd,len,sg*size(Cd,id),sg*size(Dd,id)) + else + call QSORTL84(A,Cd,Dm,len,sg*size(Cd,id),0) + endif + end if + end if + +end subroutine SORTL + + + +subroutine SORTS(A,Bi,Bl,Br,Bd,Ci,Cl,Cr,Cd,Di,Dl,Dr,Dd,DIM) + integer(kind=4), intent(INOUT) :: A(:) + integer(kind=4), optional, intent(INOUT) :: Bi(:) + integer(kind=8), optional, intent(INOUT) :: Bl(:) + real (kind=4), optional, intent(INOUT) :: Br(:) + real (kind=8), optional, intent(INOUT) :: Bd(:) + integer(kind=4), optional, intent(INOUT) :: Ci(:,:) + integer(kind=8), optional, intent(INOUT) :: Cl(:,:) + real (kind=4), optional, intent(INOUT) :: Cr(:,:) + real (kind=8), optional, intent(INOUT) :: Cd(:,:) + integer(kind=4), optional, intent(INOUT) :: Di(:,:) + integer(kind=8), optional, intent(INOUT) :: Dl(:,:) + real (kind=4), optional, intent(INOUT) :: Dr(:,:) + real (kind=8), optional, intent(INOUT) :: Dd(:,:) + integer, optional, intent(IN ) :: DIM + + integer :: uDIM, sg, id, len + integer :: Dm(0,0) + + len = size(A) + + if (present(Bi)) then + call QSORTS44(A,Bi,Dm,len,1,0) + elseif(present(Bl))then + call QSORTS84(A,Bl,Dm,len,1,0) + elseif(present(Br))then + call QSORTS44(A,Br,Dm,len,1,0) + elseif(present(Bd)) then + call QSORTS84(A,Bd,Dm,len,1,0) + else + + if(present(DIM)) then + ASSERT_(DIM>0 .and. DIM<3) + uDIM = DIM + else + uDIM = 2 + end if + + if(uDIM==1) then + sg = -1 + id = 2 + else + sg = 1 + id = 1 + end if + + if (present(Ci)) then + if (present(Di)) then + call QSORTS44(A,Ci,Di,len,sg*size(Ci,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTS48(A,Ci,Dl,len,sg*size(Ci,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTS44(A,Ci,Dr,len,sg*size(Ci,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTS48(A,Ci,Dd,len,sg*size(Ci,id),sg*size(Dd,id)) + else + call QSORTS44(A,Ci,Dm,len,sg*size(Ci,id),0) + endif + elseif(present(Cl))then + if (present(Di)) then + call QSORTS84(A,Cl,Di,len,sg*size(Cl,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTS88(A,Cl,Dl,len,sg*size(Cl,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTS84(A,Cl,Dr,len,sg*size(Cl,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTS88(A,Cl,Dd,len,sg*size(Cl,id),sg*size(Dd,id)) + else + call QSORTS84(A,Cl,Dm,len,sg*size(Cl,id),0) + endif + elseif(present(Cr))then + if (present(Di)) then + call QSORTS44(A,Cr,Di,len,sg*size(Cr,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTS48(A,Cr,Dl,len,sg*size(Cr,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTS44(A,Cr,Dr,len,sg*size(Cr,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTS48(A,Cr,Dd,len,sg*size(Cr,id),sg*size(Dd,id)) + else + call QSORTS44(A,Cr,Dm,len,sg*size(Cr,id),0) + endif + elseif(present(Cd)) then + if (present(Di)) then + call QSORTS84(A,Cd,Di,len,sg*size(Cd,id),sg*size(Di,id)) + elseif(present(Dl))then + call QSORTS88(A,Cd,Dl,len,sg*size(Cd,id),sg*size(Dl,id)) + elseif(present(Dr))then + call QSORTS84(A,Cd,Dr,len,sg*size(Cd,id),sg*size(Dr,id)) + elseif(present(Dd)) then + call QSORTS88(A,Cd,Dd,len,sg*size(Cd,id),sg*size(Dd,id)) + else + call QSORTS84(A,Cd,Dm,len,sg*size(Cd,id),0) + endif + end if + end if + +end subroutine SORTS + + + +subroutine SORTSL(A,B) + integer(kind=4), intent(INOUT) :: A(:) + integer(kind=8), intent(INOUT) :: B(:) + + call SORTS(A,Bl=B) + +end subroutine SORTSL + + +subroutine SORTSR(A,B) + integer(kind=4), intent(INOUT) :: A(:) + real (kind=4), intent(INOUT) :: B(:) + + call SORTS(A,Br=B) + +end subroutine SORTSR + +subroutine SORTSD(A,B) + integer(kind=4), intent(INOUT) :: A(:) + real (kind=8), intent(INOUT) :: B(:) + + call SORTS(A,Bd=B) + +end subroutine SORTSD + +subroutine SORTLL(A,B) + integer(kind=8), intent(INOUT) :: A(:) + integer(kind=8), intent(INOUT) :: B(:) + + call SORTL(A,Bl=B) + +end subroutine SORTLL + + +subroutine SORTLR(A,B) + integer(kind=8), intent(INOUT) :: A(:) + real (kind=4), intent(INOUT) :: B(:) + + call SORTL(A,Br=B) + +end subroutine SORTLR + +subroutine SORTLD(A,B) + integer(kind=8), intent(INOUT) :: A(:) + real (kind=8), intent(INOUT) :: B(:) + + call SORTL(A,Bd=B) + +end subroutine SORTLD + +subroutine SORT2SS(A,C,DIM) + integer(kind=4), intent(INOUT) :: A(:) + integer(kind=4), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTS(A,Ci=C,DIM=DIM) + +end subroutine SORT2SS + + +subroutine SORT2SL(A,C,DIM) + integer(kind=4), intent(INOUT) :: A(:) + integer(kind=8), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTS(A,Cl=C,DIM=DIM) + +end subroutine SORT2SL + + +subroutine SORT2SR(A,C,DIM) + integer(kind=4), intent(INOUT) :: A(:) + real (kind=4), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTS(A,Cr=C,DIM=DIM) + +end subroutine SORT2SR + +subroutine SORT2SD(A,C,DIM) + integer(kind=4), intent(INOUT) :: A(:) + real (kind=8), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTS(A,Cd=C,DIM=DIM) + +end subroutine SORT2SD + +subroutine SORT2LS(A,C,DIM) + integer(kind=8), intent(INOUT) :: A(:) + integer(kind=4), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTL(A,Ci=C,DIM=DIM) + +end subroutine SORT2LS + + +subroutine SORT2LL(A,C,DIM) + integer(kind=8), intent(INOUT) :: A(:) + integer(kind=8), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTL(A,Cl=C,DIM=DIM) + +end subroutine SORT2LL + + +subroutine SORT2LR(A,C,DIM) + integer(kind=8), intent(INOUT) :: A(:) + real (kind=4), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTL(A,Cr=C,DIM=DIM) + +end subroutine SORT2LR + +subroutine SORT2LD(A,C,DIM) + integer(kind=8), intent(INOUT) :: A(:) + real (kind=8), intent(INOUT) :: C(:,:) + integer, optional, intent(IN ) :: DIM + + call SORTL(A,Cd=C,DIM=DIM) + +end subroutine SORT2LD + +subroutine SORT2AS(A,Ci,Cl,Cr,Cd,DIM) + integer(kind=4), intent(INOUT) :: A(:,:) + integer(kind=4), optional, intent(INOUT) :: Ci(:,:) + integer(kind=8), optional, intent(INOUT) :: Cl(:,:) + real (kind=4), optional, intent(INOUT) :: Cr(:,:) + real (kind=8), optional, intent(INOUT) :: Cd(:,:) + integer, optional, intent(IN ) :: DIM + + integer :: uDIM + + if(present(DIM)) then + uDIM = DIM + else + uDIM = 2 + end if + + ASSERT_(uDIM>0 .and. uDIM<3) + + if(uDIM==1) then + call SORTS(A(:,1),Ci=A(:,2:),Di=Ci,Dl=Cl,Dr=Cr,Dd=Cd,DIM=DIM) + else + call SORTS(A(1,:),Ci=A(2:,:),Di=Ci,Dl=Cl,Dr=Cr,Dd=Cd,DIM=DIM) + end if +end subroutine SORT2AS + +subroutine SORT2AL(A,Ci,Cl,Cr,Cd,DIM) + integer(kind=8), intent(INOUT) :: A(:,:) + integer(kind=4), optional, intent(INOUT) :: Ci(:,:) + integer(kind=8), optional, intent(INOUT) :: Cl(:,:) + real (kind=4), optional, intent(INOUT) :: Cr(:,:) + real (kind=8), optional, intent(INOUT) :: Cd(:,:) + integer, optional, intent(IN ) :: DIM + + integer :: uDIM + + if(present(DIM)) then + uDIM = DIM + else + uDIM = 2 + end if + + ASSERT_(uDIM>0 .and. uDIM<3) + + if(uDIM==1) then + call SORTL(A(:,1),Cl=A(:,2:),Di=Ci,Dl=Cl,Dr=Cr,Dd=Cd,DIM=DIM) + else + call SORTL(A(1,:),Cl=A(2:,:),Di=Ci,Dl=Cl,Dr=Cr,Dd=Cd,DIM=DIM) + end if +end subroutine SORT2AL + +end module MAPL_SortMod diff --git a/shared/new_sort/quicksort.c b/shared/new_sort/quicksort.c new file mode 100644 index 00000000000..41204a8d4ea --- /dev/null +++ b/shared/new_sort/quicksort.c @@ -0,0 +1,203 @@ + + +// This function swaps i-j items of the key and of any ancillary data contained +// in the b array. n is the number of columns in b and its sign +// determines which dimension holds the columns. + + +#if LENA==4 + #define INTa int + #define SHUFFLEA Shuffle4 + #if LENB==4 + #define INTb int + #define SHUFFLEB Shuffle4 + #define QSSWAPB QSswapArr4 + #if LENC==4 + #define INTc int + #define SHUFFLEC Shuffle4 + #define QSSWAPC QSswapArr4 + #define QSWAP QswapS44 + #define QUICKSORT QuickSortS44 + #define QSORT QSORTS44 + #else + #define INTc long long + #define SHUFFLEC Shuffle8 + #define QSSWAPC QSswapArr8 + #define QSWAP QswapS48 + #define QUICKSORT QuickSortS48 + #define QSORT QSORTS48 + #endif + #else + #define INTb long long + #define SHUFFLEB Shuffle8 + #define QSSWAPB QSswapArr8 + #if LENC==4 + #define INTc int + #define SHUFFLEC Shuffle4 + #define QSSWAPC QSswapArr4 + #define QSWAP QswapS84 + #define QUICKSORT QuickSortS84 + #define QSORT QSORTS84 + #else + #define INTc long long + #define SHUFFLEC Shuffle8 + #define QSSWAPC QSswapArr8 + #define QSWAP QswapS88 + #define QUICKSORT QuickSortS88 + #define QSORT QSORTS88 + #endif + #endif +#else + #define INTa long long + #define SHUFFLEA Shuffle8 + #if LENB==4 + #define INTb int + #define SHUFFLEB Shuffle4 + #define QSSWAPB QSswapArr4 + #if LENC==4 + #define INTc int + #define SHUFFLEC Shuffle4 + #define QSSWAPC QSswapArr4 + #define QSWAP QswapL44 + #define QUICKSORT QuickSortL44 + #define QSORT QSORTL44 + #else + #define INTc long long + #define SHUFFLEC Shuffle8 + #define QSSWAPC QSswapArr8 + #define QSWAP QswapL48 + #define QUICKSORT QuickSortL48 + #define QSORT QSORTL48 + #endif + #else + #define INTb long long + #define SHUFFLEB Shuffle8 + #define QSSWAPB QSswapArr8 + #if LENC==4 + #define INTc int + #define SHUFFLEC Shuffle4 + #define QSSWAPC QSswapArr4 + #define QSWAP QswapL84 + #define QUICKSORT QuickSortL84 + #define QSORT QSORTL84 + #else + #define INTc long long + #define SHUFFLEC Shuffle8 + #define QSSWAPC QSswapArr8 + #define QSWAP QswapL88 + #define QUICKSORT QuickSortL88 + #define QSORT QSORTL88 + #endif + #endif +#endif + +void QSWAP(INTa a[], INTb b[], INTc c[], + int i, int j, int m, int n, int q) +{ + if(i!=j) { + INTa s; + + SWAP(a[i],a[j]); + + if(b && n!=0) (void)QSSWAPB(b,i,j,m,n); + if(c && q!=0) (void)QSSWAPC(c,i,j,m,q); + } +} + + + + +void QUICKSORT(INTa a[], INTb b[], INTc c[], + int l, int r, int m, int n, int q) +{ + int len=r-l+1; + + if (len<=1) { + return; + } + else if (len==2) { + if (a[l]>a[r]) QSWAP(a,b,c,l,r,m,n,q); + return; + } + else { + int j = r; + int i = l-1; + INTa v = a[r]; + + for(;;) { + while(a[++i]v && j>l); + if (j<=i) break; + QSWAP(a,b,c,i ,j,m,n,q); + } + QSWAP (a,b,c,i ,r,m,n,q); + QUICKSORT(a,b,c,l ,j,m,n,q); + QUICKSORT(a,b,c,i+1,r,m,n,q); + } +} + + +#define MAX_SORT_LEN 400000000 + + + +// If the length of the sort exceeds a critical value (MAX_SORT_LEN), +// it halves it repeatedly until it is below this value, does +// order LEN/MAX_SORT_LEN sorts, and shuffles these in ascending order. + + +void QSORT(INTa a[], INTb b[], INTc c[], int *r, int *n, int *q) { + (void)QUICKSORT(a,b,c,0,*r-1,*r,*n,*q); +#if 0 + if(*r +#include +#include + +// A quicksort implementation for intergers with Fortran bindings. + +// It sorts a list of either int's (integer*4) or long long's (integer*8), +// and optionally, uses this sort as a key to reorder either one or two +// 2-D arrays of ints. + +// The reordered dimension of the 2-D array can be either the inner or +// outer dimension, which must have the same size as the key's single +// dimension. + + +// Utility functions to swap and shuffle arrays; +// These are needed for long and short types +//============================================== + +#define SWAP(A,B) {s=B; B=A; A=s;} + +#define IS_LONG +#include "swap_shuffle.c" +#undef IS_LONG +#include "swap_shuffle.c" + + +// Overloads of routines that sort a list integers and +// and reorder up to two 2-D arrays. +//==================================================== + +// Overloads for long long (Integer*8) key + +#define LENA 4 + + #define LENB 4 + + #define LENC 4 + #include "quicksort.c" + #undef LENC + #define LENC 8 + #include "quicksort.c" + #undef LENC + + #undef LENB + #define LENB 8 + + #define LENC 4 + #include "quicksort.c" + #undef LENC + #define LENC 8 + #include "quicksort.c" + #undef LENC + + #undef LENB + +#undef LENA + +// Overloads for long long (Integer*8) key + +#define LENA 8 + + #define LENB 4 + + #define LENC 4 + #include "quicksort.c" + #undef LENC + #define LENC 8 + #include "quicksort.c" + #undef LENC + + #undef LENB + #define LENB 8 + + #define LENC 4 + #include "quicksort.c" + #undef LENC + #define LENC 8 + #include "quicksort.c" + #undef LENC + + #undef LENB + +#undef LENA + + + + +// Fortran interfaces + + +// Extra aliases for other loaders +// The Lxx and Sxx overloads refer to the kind of a, b, and c, respectively +// r is the length of the sorted list +// n is the number of reordered lists in b +// q is the number of reordered lists in c + +void qsortl44 (long long a[], int b[], int c[], int *r, int *n, int *q) { (void)QSORTL44(a,b,c,r,n,q); } +void qsortl48 (long long a[], int b[], long long c[], int *r, int *n, int *q) { (void)QSORTL48(a,b,c,r,n,q); } +void qsortl84 (long long a[], long long b[], int c[], int *r, int *n, int *q) { (void)QSORTL84(a,b,c,r,n,q); } +void qsortl88 (long long a[], long long b[], long long c[], int *r, int *n, int *q) { (void)QSORTL88(a,b,c,r,n,q); } + +void qsorts44 ( int a[], int b[], int c[], int *r, int *n, int *q) { (void)QSORTS44(a,b,c,r,n,q); } +void qsorts48 ( int a[], int b[], long long c[], int *r, int *n, int *q) { (void)QSORTS48(a,b,c,r,n,q); } +void qsorts84 ( int a[], long long b[], int c[], int *r, int *n, int *q) { (void)QSORTS84(a,b,c,r,n,q); } +void qsorts88 ( int a[], long long b[], long long c[], int *r, int *n, int *q) { (void)QSORTS88(a,b,c,r,n,q); } + +void qsortl44_(long long a[], int b[], int c[], int *r, int *n, int *q) { (void)QSORTL44(a,b,c,r,n,q); } +void qsortl48_(long long a[], int b[], long long c[], int *r, int *n, int *q) { (void)QSORTL48(a,b,c,r,n,q); } +void qsortl84_(long long a[], long long b[], int c[], int *r, int *n, int *q) { (void)QSORTL84(a,b,c,r,n,q); } +void qsortl88_(long long a[], long long b[], long long c[], int *r, int *n, int *q) { (void)QSORTL88(a,b,c,r,n,q); } + +void qsorts44_( int a[], int b[], int c[], int *r, int *n, int *q) { (void)QSORTS44(a,b,c,r,n,q); } +void qsorts48_( int a[], int b[], long long c[], int *r, int *n, int *q) { (void)QSORTS48(a,b,c,r,n,q); } +void qsorts84_( int a[], long long b[], int c[], int *r, int *n, int *q) { (void)QSORTS84(a,b,c,r,n,q); } +void qsorts88_( int a[], long long b[], long long c[], int *r, int *n, int *q) { (void)QSORTS88(a,b,c,r,n,q); } + +void QSORTL44_(long long a[], int b[], int c[], int *r, int *n, int *q) { (void)QSORTL44(a,b,c,r,n,q); } +void QSORTL48_(long long a[], int b[], long long c[], int *r, int *n, int *q) { (void)QSORTL48(a,b,c,r,n,q); } +void QSORTL84_(long long a[], long long b[], int c[], int *r, int *n, int *q) { (void)QSORTL84(a,b,c,r,n,q); } +void QSORTL88_(long long a[], long long b[], long long c[], int *r, int *n, int *q) { (void)QSORTL88(a,b,c,r,n,q); } + +void QSORTS44_( int a[], int b[], int c[], int *r, int *n, int *q) { (void)QSORTS44(a,b,c,r,n,q); } +void QSORTS48_( int a[], int b[], long long c[], int *r, int *n, int *q) { (void)QSORTS48(a,b,c,r,n,q); } +void QSORTS84_( int a[], long long b[], int c[], int *r, int *n, int *q) { (void)QSORTS84(a,b,c,r,n,q); } +void QSORTS88_( int a[], long long b[], long long c[], int *r, int *n, int *q) { (void)QSORTS88(a,b,c,r,n,q); } diff --git a/shared/new_sort/swap_shuffle.c b/shared/new_sort/swap_shuffle.c new file mode 100644 index 00000000000..c90ad7f6166 --- /dev/null +++ b/shared/new_sort/swap_shuffle.c @@ -0,0 +1,69 @@ + +#ifdef IS_LONG + #define INTt long long + #define QSSWAPARR QSswapArr8 + #define SHUFFLE Shuffle8 +#endif + +#ifndef IS_LONG + #define INTt int + #define QSSWAPARR QSswapArr4 + #define SHUFFLE Shuffle4 +#endif + + + + +QSSWAPARR(INTt b[], int i, int j, int m, int n) +{ +// This function swaps i-j items of a 2-D array of ints contained +// in b. n is the number of lists to be reordered and its sign +// determines which dimension of b spans the lists. + + INTt s; + int k; + + if (n> 1) { // reordering the outer Fortran dimension (inner C dimension) + for(k=0;k< n;k++) SWAP(b[n*i+k],b[n*j+k]); + } + else if(n<-1) { // reordering the inner Fortran dimension (outer C dimension) + printf("In swap %d %d %d %d\n",i,j,m,n); + for(k=0;k<-n;k++) SWAP(b[i+m*k],b[j+m*k]); + } + else { + SWAP(b[i],b[j]); + } +} + +void SHUFFLE(INTt *a, int lenm, int lenp, int stride) +{ + + int r=lenm+lenp, i; + INTt *aml, *apl, *am, *ap, *a0; + + a0 = (INTt *)malloc(lenm*sizeof(INTt)); + + am = a0; + ap = a + lenm*stride; + + aml = am + lenm; + apl = ap + lenp*stride; + + for(i=0;i