SUBROUTINE TTSORT(NQ,NPTS,ITIME,OUT,IRECS,RECS,INDX)
INTEGER NQ,NPTS,ITIME,IRECS(NPTS),INDX(NPTS)
REAL OUT(NQ,NPTS),RECS(NPTS)
C
C Subroutine designed to sort two-point rays according to receiver
C indices. For the same receiver, the rays are sorted according to
C travel time.
C
C Input:
C NQ... Number of real quantities considered at a ray point.
C If NQ is less than ITIME, no subsequent sorting according
C to travel time is performed.
C NPTS... Number of ray points stored in array OUT.
C ITIME...Rays at each receiver are sorted according to travel times
C OUT(ITIME,*).
C OUT... For each ray point, NQ quantities, the ITIME-th of them
C should be travel time.
C IRECS.. Indices of receivers corresponding to rays.
C RECS... Temporary storage array for floating-point counterpart of
C integer array IRECS. May be equivalent with IRECS, i.e.
C may be declared by statements
C REAL RECS(NPTS)
C EQUIVALENCE (IRECS,RECS)
C in the calling subroutine.
C Output:
C INDX... Indices of sorted rays.
C
C Subroutines and external functions required:
EXTERNAL INDEXX
C INDEXX..File 'indexx.for'.
C
C Date: 1996, September 30
C Coded by Ludek Klimes
C
C-----------------------------------------------------------------------
C
C Local storage locations:
INTEGER I,I1,J,JREC
REAL TTMIN,TTSCL
C
C.......................................................................
C
C Sorting according to (1) receivers, (2) travel times:
IF (NQ.GE.ITIME) THEN
TTMIN= 999999.
TTSCL=-999999.
DO 11 I=1,NPTS
TTMIN=AMIN1(OUT(ITIME,I),TTMIN)
TTSCL=AMAX1(OUT(ITIME,I),TTSCL)
11 CONTINUE
TTSCL=TTSCL-TTMIN
IF(TTSCL.GT.0.) THEN
TTSCL=0.998/TTSCL
END IF
DO 12 I=1,NPTS
RECS(I)=FLOAT(IRECS(I))+0.001+(OUT(ITIME,I)-TTMIN)*TTSCL
12 CONTINUE
ELSE
DO 13 I=1,NPTS
RECS(I)=FLOAT(IRECS(I))+0.001
13 CONTINUE
END IF
CALL INDEXX(NPTS,RECS,INDX)
DO 14 I=1,NPTS
IRECS(I)=INT(RECS(I))
14 CONTINUE
C
C Fine resorting according to travel times:
IF (NQ.GE.ITIME) THEN
I1=1
21 CONTINUE
JREC=0
DO 22 I=I1,NPTS
J=INDX(I)
IF(IRECS(J).EQ.JREC) THEN
IF(OUT(ITIME,J).LT.OUT(ITIME,INDX(I-1))) THEN
C Exchanging rays, and checking the receiver again:
INDX(I) =INDX(I-1)
INDX(I-1)=J
GO TO 21
END IF
ELSE
I1=I
END IF
JREC=IRECS(J)
22 CONTINUE
END IF
C
RETURN
END
C
C=======================================================================
C