CTITLESAIED3 -- SMOOTH FIRST BREAK TIMES FOR AIED 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR RANDY PROBST 00020000 CA DESIGNER RANDY PROBST 00030000 CA LANGUAGE FORTRAN 00040000 CA SYSTEM IBM AND CRAY 00050000 CA WRITTEN 09-19-86 00060000 C REVISED 00070000 CA 00080000 CA 00090000 CA CALL SAIED3 (X, Y, INC, NSMP, SPLIT, LCPI, BUF, PRTFLG, IPR) 00100000 CA IN X = ARRAY OF TRACE POSITIONS I4 00110000 CA IN/OUT Y = ARRAY OF FIRST BREAK TIMES TO BE SMOOTHED I4 00120000 CA IN INC = INDEX INCREMENT IN X & Y I4 00130000 CA IN NSMP = NUMBER OF TRACES I4 00140000 CA IN SPLIT = 0 => NO VERTEX (SPLIT SPREAD) I4 00150000 CA -1 => DETERMINE VERTEX 00160000 CA >0 => APPROXIMATE VERTEX TO START SEACH 00170000 CA IN LCPI = SAMPLE INTERVAL I4 00180000 CA OUT BUF = SCRATCH BUFFER (9*NSMP WORDS) I4 00190000 CA IN PRTFLG = DIAGNOSTIC PRINT FLAG (=2048 CAUSES PRINT)I4 00200000 CA IN IPR = LOGICAL UNIT FOR PRINT I4 00210000 CA 00220000 CA 00230000 CA THIS ROUTINE SMOOTHES THE CALCULATED FIRST BREAKS. IT WILL 00240000 CA SEARCH FOR A VERTEX IF REQUESTED TO. IF APPROXIMATE VERTEX IS 00250000 CA KNOWN THEN IT WILL SEARCH FROM 12 BEFORE TO 12 AFTER TO DETERMINE 00260000 CA THE VERTEX. USPFIT IS USED. 00270000 CA 00280000 SUBROUTINE SAIED3 (X,Y,INC,NSMP,SPLIT,LCPI,BUF,PRTFLG,IPR) 00290000 IMPLICIT INTEGER (A-Z) 00300000 C 00310000 INTEGER X(1), Y(1) 00320000 C 00330000 REAL BUF (9,1) 00340000 REAL MIN 00350000 C 00360000 C SAVE SPLIT PARM 00370000 C 00380000 10 CONTINUE 00390000 SVSPLT = SPLIT 00400000 C 00410000 C TEST FOR NOT A SPLIT SPREAD 00420000 C 00430000 IF (SPLIT .NE. 0) GO TO 50 00440000 B = 1 00450000 E = 1 00460000 L = 1 00470000 GO TO 90 00480000 C 00490000 C IS A SPLIT SPREAD TEST FOR KNOWN VERTEX OR NOT 00500000 C 00510000 50 CONTINUE 00520000 IF (SPLIT .GT. 0) THEN 00530000 B = SPLIT - 12 00540000 IF (B .LT. 1) B = 1 00550000 E = SPLIT + 12 00560000 IF (E .GT. NSMP) E = NSMP 00570000 ELSE 00580000 B = 1 00590000 E = NSMP 00600000 END IF 00610000 C 00620000 90 CONTINUE 00630000 DO 100 K = B, E 00640000 C 00650000 IF (K .GT. 2) THEN 00660000 CALL USPFIT(X, Y, INC, K, LCPI, 2, BUF(2,K), 00670000 + BUF(3,K), PRTFLG, IPR) 00680000 ELSE 00690000 BUF(2,K) = 99999.0 00700000 END IF 00710000 IF (K .LT. NSMP-1) THEN 00720000 I = (K-1) * INC + 1 00730000 J = NSMP - K + 1 00740000 CALL USPFIT(X(I), Y(I), INC, J, LCPI, 2, BUF(6,K), 00750000 + BUF(7,K), PRTFLG, IPR) 00760000 ELSE 00770000 BUF(6,K) = 99999.0 00780000 END IF 00790000 C 00800000 100 CONTINUE 00810000 C 00820000 C 00830000 IF (SPLIT .EQ. 0) GO TO 350 00840000 MIN = 99999.0 00850000 DO 300 K = B, E 00860000 BUF(1,K) = BUF(2,K) + BUF(6,K) 00870000 IF (BUF(1,K) .LE. MIN) THEN 00880000 L = K 00890000 MIN = BUF(1,K) 00900000 END IF 00910000 300 CONTINUE 00920000 SPLIT = L 00930000 C 00940000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 00950000 IF (IAND(PRTFLG, 2048) .NE. 0) THEN 00960000 DO 200 K = B, E 00970000 WRITE(IPR, 1000) K,(BUF(I,K),I=1,9) 00980000 1000 FORMAT(' SAIED3',I3, E13.4, 2(4E13.4,3X)) 00990000 200 CONTINUE 01000000 END IF 01010000 IF (IAND(PRTFLG, 2) .NE. 0 .OR. IAND(PRTFLG, 2048) .NE. 0) 01020000 + WRITE(IPR, 2000) L 01030000 2000 FORMAT(' SAIED3 -SPLIT SPREAD VERTEX-',I4) 01040000 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 01050000 C 01060000 C TEST FOR VERTEX FOUND AT EDGE OF TEST AREA 01070000 C 01080000 IF (SVSPLT .LE. 0) GO TO 350 01090000 IF (SPLIT .LT. (SVSPLT-10) .AND. 01100000 + SPLIT .GT. 3) GO TO 10 01110000 IF (SPLIT .GT. (SVSPLT+10) .AND. 01120000 + SPLIT .LT. NSMP-2) GO TO 10 01130000 C 01140000 C SMOOTH THE ARRAY 01150000 C 01160000 350 CONTINUE 01170000 IF (L .GT. 1) THEN 01180000 DO 400 J = 1, L-1 01190000 I = (J-1) * INC + 1 01200000 IF (Y(I) .GE. 0) 01210000 + Y(I) = BUF(3,L) + BUF(4,L)*X(I) + BUF(5,L)*X(I)*X(I) 01220000 IF (Y(I) .LT. -LCPI) Y(I) = 0 01230002 400 CONTINUE 01240000 END IF 01250000 C 01260000 IF (L .LT. NSMP) THEN 01270000 DO 500 J = L, NSMP 01280000 I = (J-1) * INC + 1 01290000 IF (Y(I) .GE. 0) 01300000 + Y(I)= BUF(7,L) + BUF(8,L)*X(I) + BUF(9,L)*X(I)*X(I) 01310000 IF (Y(I) .LT. -LCPI) Y(I) = 0 01320002 500 CONTINUE 01330000 END IF 01340000 C 01350000 RETURN 01360000 END 01370000