*********************************************************************sdk ************************************************************************ * * Subroutine QSORTFF * * Function: * Sort real value in descending order, co-sort peaks (real) * * Method: * Quicksort (H.A.R. Hoare, "Quicksort", Comp. J. 5(1):10-15 * (1962). * * Comment: * Code translated from Pascal version in * N. Wirth, Algorithms + Data Structures = Programs, * 1976 Prentice-Hall Inc, Englewood Cliffs, New Jersey. * * Arguments: * Np (i) number of elements to sort * Peaks (i/o) associated 3 x np real array * Value (i/o) sort key real array * Errcod (o) error code * errcod = 0 - no error * errcod = 1 - stack overflow * * History: * Tested OK November 23 1991 sdk * First attempts November 23 1991 S. Knight ************************************************************************ subroutine qsortff ( np , peaks , value , errcod ) implicit none * Arguments integer np real value(np) real peaks(3,np) integer errcod * Local variables integer i , j , l , r , s , x integer m parameter ( m = 12 ) integer stack( 2,m ) real valsav real peksav(3) *----------------------------------------------------------------------- * Initialize error code errcod = 0 * Don't bother if nothing to sort if ( np .le. 1 ) return * Initialize stack s = 1 stack( 1,1 ) = 1 stack( 2,1 ) = np * Conditional loop 1 100 continue * Take top request from stack l = stack( 1,s ) r = stack( 2,s ) s = s - 1 * Conditional loop 2 200 continue * Split interval l-r until nothing left, chose middle of * interval as comparand i = l j = r x = ( i + j ) / 2 * Conditional loop 3 300 continue * Partition if ( value( i ) .gt. value( x ) ) then i = i + 1 goto 300 endif 310 if ( value( x ) .gt. value( j ) ) then j = j - 1 goto 310 endif * Swap and if necessary reset comparand pointer if ( i .le. j ) then valsav = value( i ) peksav( 1 ) = peaks( 1,i ) peksav( 2 ) = peaks( 2,i ) peksav( 3 ) = peaks( 3,i ) value( i ) = value( j ) peaks( 1,i ) = peaks( 1,j ) peaks( 2,i ) = peaks( 2,j ) peaks( 3,i ) = peaks( 3,j ) value( j ) = valsav peaks( 1,j ) = peksav( 1 ) peaks( 2,j ) = peksav( 2 ) peaks( 3,j ) = peksav( 3 ) if ( x .eq. i ) then x = j else if ( x .eq. j ) then x = i endif i = i + 1 j = j - 1 endif * End of conditional loop 3 if ( i .le. j ) goto 300 * Set up requests: short interval now, long interval to stack if ( j - l .lt. r - i ) then if ( i .lt. r ) then * Stack request for sorting right partition s = s + 1 if ( s .gt. m ) goto 999 stack( 1,s ) = i stack( 2,s ) = r endif * and continue sorting left partition r = j else if ( l .lt. j ) then * Stack request for sorting left partition s = s + 1 if ( s .gt. m ) goto 999 stack( 1,s ) = l stack( 2,s ) = j endif * and continue sorting right partition l = i endif * End of conditional loop 2 if ( l .lt. r ) goto 200 * End of conditional loop 3 if ( s .gt. 0 ) goto 100 * All done return 999 errcod = 1 return end