sortc(3f) - [M_datapac:SORT] sort a vector of sample
observations and "carry" a second vector
Subroutine sortc(X,Y,N,Xs,Yc)
Real(kind=wp), Intent (In) :: X
Real(kind=wp), Intent (In) :: Y
Integer, Intent (In) :: N
Real(kind=wp), Intent (Out) :: Xs
Real(kind=wp), Intent (Out) :: Yc
SORTC(3f) sorts (in ascending order) the N elements of the vector X,
puts the resulting N sorted values into the vector XS,
rearranges the elements of the vector Y (according to the sort on X),
and puts the rearranged Y values into the vector YC.
This subroutine gives the data analyst the ability to sort one data
vector while 'carrying along' the elements of a second data vector.
The smallest element of the vector X will be placed in the first
position of the vector XS, the second smallest element in the vector
X will be placed in the second position of the vector XS, etc.
The element in the vector Y corresponding to the smallest element in
X will be placed in the first position of the vector YC, the element
in the vector Y corresponding to the second smallest element in X
will be placed in the second position of the vector YC, etc.
The input vector X remains unaltered.
If the analyst desires a sort 'in place', this is done by having the
same output vector as input vector in the calling sequence. Thus,
for example, the calling sequence CALL SORTC(X,Y,N,X,YC) is allowable
and will result in the desired 'in-place' sort.
The sorting algorithm used herein is the binary sort. This algorithm
is extremely fast as the following time trials indicate. These time
trials were carried out on the UNIVAC 1108 EXEC 8 system at NBS in
August of 1974. By way of comparison, the time trial values for the
easy-to-program but extremely inefficient bubble sort algorithm have
also been included--
Number of Random Binary Sort Bubble Sort
Numbers Sorted
N = 10 .002 sec .002 sec
N = 100 .011 sec .045 sec
N = 1000 .141 sec 4.332 sec
N = 3000 .476 sec 37.683 sec
N = 10000 1.887 sec NOT COMPUTED
X The vector of observations to be sorted.
Y The vector of
observations to be 'carried along', that is, to be rearranged
according to the sort on X.
N The integer number of observations in the vector X.
XS The vector into which the sorted data values from X will be
placed in ascending order.
YC The vector into which the rearranged (according to the sort of
the vector X) values of the vector Y will be placed.
Sample program:
program demo_sortc
use M_datapac, only : sortc, label
implicit none
integer,parameter :: isz=20
real :: aa(isz)
real :: bb(isz)
real :: cc(isz)
real :: dd(isz)
integer :: i
call label('sortc')
write(*,*)'initializing array with ',isz,' random numbers'
call random_seed()
CALL RANDOM_NUMBER(aa)
aa=aa*450000.0
bb=real([(i,i=1,isz)])
call sortc(aa,bb,size(aa),cc,dd)
write(*,*)'checking if real values are sorted(3f)'
do i=1,isz-1
if(cc(i).gt.cc(i+1))then
write(*,*)'Error in sorting reals small to large ',i,cc(i),cc(i+1)
endif
enddo
write(*,*)'test of sortc(3f) complete'
write(*,'(4(g0,1x))')(aa(i),bb(i),cc(i),dd(i),i=1,isz)
write(*,'(*(g0,1x))')sum(aa),sum(cc) ! should be the same if no truncation
write(*,'(*(g0,1x))')sum(bb),sum(dd)
end program demo_sortc
Results:
The original DATAPAC library was written by James Filliben of the Statistical
Engineering Division, National Institute of Standards and Technology.
John Urban, 2022.05.31
CC0-1.0
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| real(kind=wp) | :: | X(:) | ||||
| real(kind=wp) | :: | Y(:) | ||||
| integer | :: | N | ||||
| real(kind=wp) | :: | Xs(:) | ||||
| real(kind=wp) | :: | Yc(:) |
SUBROUTINE SORTC(X,Y,N,Xs,Yc) REAL(kind=wp) :: amed, bmed, hold, tx, ty, X(:), Xs(:), Y(:), Yc(:) INTEGER i, il(36), ip1, iu(36), j, jmi, jmk, k, l, lmi, m, mid, N, nm1 ! ! RESTRICTIONS--THE DIMENSIONS OF THE VECTORS IL AND IU ! (DEFINED AND USED INTERNALLY WITHIN ! THIS SUBROUTINE) DICTATE THE MAXIMUM ! ALLOWABLE VALUE OF N FOR THIS SUBROUTINE. ! IF IL AND IU EACH HAVE DIMENSION K, ! THEN N MAY NOT EXCEED 2**(K+1) - 1. ! FOR THIS SUBROUTINE AS WRITTEN, THE DIMENSIONS ! OF IL AND IU HAVE BEEN SET TO 36, ! THUS THE MAXIMUM ALLOWABLE VALUE OF N IS ! APPROXIMATELY 137 BILLION. ! SINCE THIS EXCEEDS THE MAXIMUM ALLOWABLE ! VALUE FOR AN INTEGER VARIABLE IN MANY COMPUTERS, ! AND SINCE A SORT OF 137 BILLION ELEMENTS ! IS PRESENTLY IMPRACTICAL AND UNLIKELY, ! THEN THERE IS NO PRACTICAL RESTRICTION ! ON THE MAXIMUM VALUE OF N FOR THIS SUBROUTINE. ! (IN LIGHT OF THE ABOVE, NO CHECK OF THE ! UPPER LIMIT OF N HAS BEEN INCORPORATED ! INTO THIS SUBROUTINE.) !--------------------------------------------------------------------- ! CHECK THE INPUT ARGUMENTS FOR ERRORS ! IF ( N<1 ) THEN WRITE (G_IO,99001) 99001 FORMAT (' ','***** FATAL ERROR--The second input argument to SORTC(3f) is non-positive *****') WRITE (G_IO,99002) N 99002 FORMAT (' ','***** The value of the argument is ',I0,' *****') RETURN ELSE IF ( N==1 ) THEN WRITE (G_IO,99003) 99003 FORMAT (' ','***** NON-FATAL DIAGNOSTIC--The second input argument to SORTC(3f) has the value 1 *****') Xs(1) = X(1) Yc(1) = Y(1) RETURN ELSE hold = X(1) DO i = 2 , N IF ( X(i)/=hold ) GOTO 50 ENDDO WRITE (G_IO,99004) hold 99004 FORMAT (' ', & & '***** NON-FATAL DIAGNOSTIC--The first input argument (a vector) to SORTC(3f) has all elements =', & & E15.8, & & ' *****') DO i = 1 , N Xs(i) = X(i) Yc(i) = Y(i) ENDDO RETURN ENDIF ! !-----START POINT----------------------------------------------------- ! ! COPY THE VECTOR X INTO THE VECTOR XS 50 continue DO i = 1 , N Xs(i) = X(i) ENDDO ! ! COPY THE VECTOR Y INTO THE VECTOR YS ! DO i = 1 , N Yc(i) = Y(i) ENDDO ! ! CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED ! nm1 = N - 1 DO i = 1 , nm1 ip1 = i + 1 IF ( Xs(i)>Xs(ip1) ) GOTO 100 ENDDO RETURN ENDIF 100 continue m = 1 i = 1 j = N 200 continue IF ( i>=j ) GOTO 400 300 continue k = i mid = (i+j)/2 amed = Xs(mid) bmed = Yc(mid) IF ( Xs(i)>amed ) THEN Xs(mid) = Xs(i) Yc(mid) = Yc(i) Xs(i) = amed Yc(i) = bmed amed = Xs(mid) bmed = Yc(mid) ENDIF l = j IF ( Xs(j)<amed ) THEN Xs(mid) = Xs(j) Yc(mid) = Yc(j) Xs(j) = amed Yc(j) = bmed amed = Xs(mid) bmed = Yc(mid) IF ( Xs(i)>amed ) THEN Xs(mid) = Xs(i) Yc(mid) = Yc(i) Xs(i) = amed Yc(i) = bmed amed = Xs(mid) bmed = Yc(mid) ENDIF ENDIF DO l = l - 1 IF ( Xs(l)<=amed ) THEN tx = Xs(l) ty = Yc(l) DO k = k + 1 IF ( Xs(k)>=amed ) THEN IF ( k<=l ) THEN Xs(l) = Xs(k) Yc(l) = Yc(k) Xs(k) = tx Yc(k) = ty EXIT ELSE lmi = l - i jmk = j - k IF ( lmi<=jmk ) THEN il(m) = k iu(m) = j j = l m = m + 1 ELSE il(m) = i iu(m) = l i = k m = m + 1 ENDIF GOTO 500 ENDIF ENDIF ENDDO ENDIF ENDDO 400 continue m = m - 1 IF ( m==0 ) RETURN i = il(m) j = iu(m) 500 continue jmi = j - i IF ( jmi>=11 ) GOTO 300 IF ( i==1 ) GOTO 200 i = i - 1 DO i = i + 1 IF ( i==j ) GOTO 400 amed = Xs(i+1) bmed = Yc(i+1) IF ( Xs(i)>amed ) THEN k = i DO Xs(k+1) = Xs(k) Yc(k+1) = Yc(k) k = k - 1 IF ( amed>=Xs(k) ) THEN Xs(k+1) = amed Yc(k+1) = bmed EXIT ENDIF ENDDO ENDIF ENDDO END SUBROUTINE SORTC