C        THIS ROUTINE IS A FAST DOUBLE-PRECISION POINTER BUBBLE SORT.
C        IT DOES NOT DO THE ACTUAL EXCHANGING OF ELEMENTS.  TO DO SO,
C        THE MAIN ROUTINE SHOULD HAVE A(I)=AR(IPTR(I)).
      SUBROUTINE PTRSRT(AR,N,IPTR)
      IMPLICIT REAL*8(A)
      DIMENSION AR(N),IPTR(N)
      DO 10 K=1,N
   10 IPTR(K)=K
      N1=N-1
      DO 20 K=1,N1
      K1=N-K
      IFLG=0
      DO 30 L=1,K1
      IF(AR(IPTR(L)).LE.AR(IPTR(L+1))) GO TO 30
      IFLG=1
      I=IPTR(L)
      IPTR(L)=IPTR(L+1)
      IPTR(L+1)=I
   30 CONTINUE
C        NOTE THAT THE ROUTINE STOPS IF NO EXCHANGES ARE MADE ON
C        ANY GIVEN PASS.  MAXIMUM SORT STEPS IS N(N-1)/2.  THE
C        POINTERS WIL SORT THE ARRAY TO BE INCREASING.
      IF(IFLG.EQ.0) RETURN
   20 CONTINUE
      RETURN
      END