SUBROUTINE FSORTH(A,IDX,N) ! heap sort (real)
*     real keys A(*), unchanged at return 
*     N indices IDX(1) ... IDX(N), changed at return such that
*        A(IDX(L)) <= A(IDX(L+1)) 
      INTEGER I,J,L,R,IDXT,N,IDX(N) 
      REAL A(*),AT    ! array of keys and pivot key value
      L=N/2+1
      R=N
   10 IF(L.GT.1) THEN
         L=L-1
         IDXT=IDX(L)
         AT  =A(IDXT)
      ELSE
         IDXT=IDX(R)
         AT  =A(IDXT)
         IDX(R)=IDX(1)
         R=R-1
         IF(R.EQ.1) THEN
            IDX(1)=IDXT
            RETURN
         END IF
      END IF
      I=L
      J=L+L
   20 IF(J.LE.R) THEN
         IF(J.LT.R) THEN
            IF(A(IDX(J)).LT.A(IDX(J+1))) J=J+1
         END IF
         IF(AT.LT.A(IDX(J))) THEN
            IDX(I)=IDX(J)
            I=J
            J=J+J
         ELSE
            J=R+1
         END IF
         GOTO 20
      END IF
      IDX(I)=IDXT
      GOTO 10
      END