sortp(3f) - [M_datapac:SORT] sorts and ranks a numeric
vector X
SUBROUTINE SORTP(X,N,Y,Xpos)
Real(kind=wp) :: (In) :: X(N)
Integer, Intent (In) :: N
Real(kind=wp) :: (Out) :: Y(N)
Real(kind=wp) :: (Out) :: XPOS(N)
SORTP(3f) sorts (in ascending order) the N elements of the precision precision vector X, puts the resulting N sorted values into the precision precision vector Y; and puts the position (in the original vector X) of each of the sorted values into the REAL vector XPOS.
This subroutine gives the data analyst not only the ability to determine what the MIN and MAX (for example) of the data set are, but also where in the original data set the MIN and MAX occur.
This is especially useful for large data sets.
X description of parameter
Y description of parameter
Sample program:
program demo_sortp
use M_datapac, only : sortp
implicit none
! call sortp(x,y)
end program demo_sortp
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), | dimension(:) | :: | X | |||
| integer | :: | N | ||||
| real(kind=wp), | dimension(:) | :: | Y | |||
| real(kind=wp), | dimension(:) | :: | Xpos |
SUBROUTINE SORTP(X,N,Y,Xpos) REAL(kind=wp) :: amed , bmed , hold , tt , X , Xpos , Y INTEGER :: i , il , ip1 , itt , iu , j , jmi , jmk , k , l ,lmi , m , mid , N , nm1 ! INPUT ARGUMENTS--X = THE VECTOR OF ! OBSERVATIONS TO BE SORTED. ! --N = THE INTEGER NUMBER OF OBSERVATIONS ! IN THE VECTOR X. ! OUTPUT ARGUMENTS--Y = THE VECTOR ! INTO WHICH THE SORTED DATA VALUES ! FROM X WILL BE PLACED. ! --XPOS = THE VECTOR ! INTO WHICH THE POSITIONS ! (IN THE ORIGINAL VECTOR X) ! OF THE SORTED VALUES ! WILL BE PLACED. ! OUTPUT--THE VECTOR XS ! CONTAINING THE SORTED ! (IN ASCENDING ORDER) VALUES ! OF THE VECTOR X, AND ! THE VECTOR XPOS ! CONTAINING THE POSITIONS ! (IN THE ORIGINAL VECTOR X) ! OF THE SORTED VALUES. ! PRINTING--NONE UNLESS AN INPUT ARGUMENT ERROR CONDITION EXISTS. ! 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.) ! COMMENT--THE SMALLEST ELEMENT OF THE VECTOR X ! WILL BE PLACED IN THE FIRST POSITION ! OF THE VECTOR Y, ! THE SECOND SMALLEST ELEMENT IN THE VECTOR X ! WILL BE PLACED IN THE SECOND POSITION ! OF THE VECTOR Y, ! ETC. ! COMMENT--THE POSITION (1 THROUGH N) IN X ! OF THE SMALLEST ELEMENT IN X ! WILL BE PLACED IN THE FIRST POSITION ! OF THE VECTOR XPOS, ! THE POSITION (1 THROUGH N) IN X ! OF THE SECOND SMALLEST ELEMENT IN X ! WILL BE PLACED IN THE SECOND POSITION ! OF THE VECTOR XPOS, ! ETC. ! ALTHOUGH THESE POSITIONS ARE NECESSARILY ! INTEGRAL VALUES FROM 1 TO N, IT IS TO BE ! NOTED THAT THEY ARE OUTPUTED AS SINGLE ! PRECISION INTEGERS IN THE ! VECTOR XPOS. ! XPOS IS SO AS TO BE ! CONSISTENT WITH THE FACT THAT ALL ! VECTOR ARGUMENTS IN ALL OTHER ! DATAPAC SUBROUTINES ARE . ! COMMENT--THE INPUT VECTOR X REMAINS UNALTERED. ! COMMENT--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 SORTP(X,N,X,XPOS) ! IS ALLOWABLE AND WILL RESULT IN ! THE DESIRED 'IN-PLACE' SORT. ! COMMENT--THE SORTING ALGORTHM USED HEREIN ! IS THE BINARY SORT. ! THIS ALGORTHIM 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 ! ORIGINAL VERSION--JUNE 1972. ! UPDATED --NOVEMBER 1975. ! !--------------------------------------------------------------------- ! DIMENSION X(:) , Y(:) , Xpos(:) DIMENSION iu(36) , il(36) ! ! CHECK THE INPUT ARGUMENTS FOR ERRORS ! IF ( N<1 ) THEN WRITE (G_IO,99001) 99001 FORMAT (' ','***** FATAL ERROR--THE SECOND INPUT ARGUMENT TO THE SORTP SUBROUTINE 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 THE SORTP SUBROUTINE HAS THE VALUE 1 *****') Y(1) = X(1) Xpos(1) = 1.0_wp 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 THE SORTP SUBROUTINE HAS ALL ELEMENTS =',& & E15.8,& & ' *****') DO i = 1 , N Y(i) = X(i) Xpos(i) = i ENDDO RETURN ENDIF ! !-----START POINT----------------------------------------------------- ! ! COPY THE VECTOR X INTO THE VECTOR Y 50 DO i = 1 , N Y(i) = X(i) ENDDO ! ! DEFINE THE XPOS (POSITION) VECTOR. BEFORE SORTING, THIS WILL ! BE A VECTOR WHOSE I-TH ELEMENT IS EQUAL TO I. ! DO i = 1 , N Xpos(i) = i ENDDO ! ! CHECK TO SEE IF THE INPUT VECTOR IS ALREADY SORTED ! nm1 = N - 1 DO i = 1 , nm1 ip1 = i + 1 IF ( Y(i)>Y(ip1) ) GOTO 100 ENDDO RETURN ENDIF 100 m = 1 i = 1 j = N 200 IF ( i>=j ) GOTO 400 300 k = i mid = (i+j)/2 amed = Y(mid) bmed = Xpos(mid) IF ( Y(i)>amed ) THEN Y(mid) = Y(i) Xpos(mid) = Xpos(i) Y(i) = amed Xpos(i) = bmed amed = Y(mid) bmed = Xpos(mid) ENDIF l = j IF ( Y(j)<amed ) THEN Y(mid) = Y(j) Xpos(mid) = Xpos(j) Y(j) = amed Xpos(j) = bmed amed = Y(mid) bmed = Xpos(mid) IF ( Y(i)>amed ) THEN Y(mid) = Y(i) Xpos(mid) = Xpos(i) Y(i) = amed Xpos(i) = bmed amed = Y(mid) bmed = Xpos(mid) ENDIF ENDIF DO l = l - 1 IF ( Y(l)<=amed ) THEN tt = Y(l) itt = Xpos(l) DO k = k + 1 IF ( Y(k)>=amed ) THEN IF ( k<=l ) THEN Y(l) = Y(k) Xpos(l) = Xpos(k) Y(k) = tt Xpos(k) = itt 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 m = m - 1 IF ( m==0 ) RETURN i = il(m) j = iu(m) 500 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 = Y(i+1) bmed = Xpos(i+1) IF ( Y(i)>amed ) THEN k = i DO Y(k+1) = Y(k) Xpos(k+1) = Xpos(k) k = k - 1 IF ( amed>=Y(k) ) THEN Y(k+1) = amed Xpos(k+1) = bmed EXIT ENDIF ENDDO ENDIF ENDDO END SUBROUTINE SORTP