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