SpectraRust/tlusty/extracted/indexx.f
2026-03-19 14:05:33 +08:00

46 lines
904 B
Fortran

SUBROUTINE INDEXX(N,ARRIN,INDX)
C ===============================
C
C Sorting routine
C
INCLUDE 'IMPLIC.FOR'
DIMENSION ARRIN(N),INDX(N)
DO J=1,N
INDX(J)=J
END DO
M=N/2+1
IR=N
10 CONTINUE
IF(M.GT.1)THEN
M=M-1
INDXT=INDX(M)
Q=ARRIN(INDXT)
ELSE
INDXT=INDX(IR)
Q=ARRIN(INDXT)
INDX(IR)=INDX(1)
IR=IR-1
IF(IR.EQ.1)THEN
INDX(1)=INDXT
RETURN
END IF
END IF
I=M
J=M+M
20 IF(J.LE.IR)THEN
IF(J.LT.IR)THEN
IF(ARRIN(INDX(J)).LT.ARRIN(INDX(J+1)))J=J+1
END IF
IF(Q.LT.ARRIN(INDX(J))) THEN
INDX(I)=INDX(J)
I=J
J=J+J
ELSE
J=IR+1
ENDIF
GO TO 20
END IF
INDX(I)=INDXT
GO TO 10
END