CTITLESDCORA -- MULTI-TRACE CROSS-SPECTRAL ANALYSIS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00020000 CA AUTHOR D. L. JONES 00030000 CA DESIGNER R. D. KNIGHT 00040000 CA LANGUAGE VS-FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 08/15/83 00070000 CA REVISED 11/87 BY RDK. REDESIGNED FOR SPARC 00080000 CA FROM SPARCD. 00090000 C REVISED 06-24-88 TJT. MADE LCGRPI FLOATING PT. CHANGE PERMANENT 00100000 C REVISED 12-14-88 RDK. MAKE SURE WORK FILE IS CLOSED ON EXIT. 00110000 C REVISED 07-12-89 LWC. CORRECT KPRTF AT END OF PROCESS. INCREASE 00120000 C MAX NUMBER OF CDPS FROM 500 TO 2000. 00130000 C REVISED 09-28-89 LWC. INT FUNCTION FOR CFT77. 00140000 C REVISED 03-27-90 LWC. ADD PARAMETER TO FOISSD CALL. 00150000 C REVISED 03-19-91 ESN. ADD OPTION TO SPECIFY ABSOLUTE 00160000 C NORMALIZATION VALUE. 00170000 CA 00180000 CA CALL SDCORA (INH,INTR,OH,OTR) 00190000 CA INPUT INH = INPUT HEADER MIXED I2, I4, R4, R8 00200000 CA INPUT INTR = INPUT TRACE R4 00210000 CA OUTPUT OH = OUTPUT HEADER MIXED I2, I4, R4, R8 00220000 CA OUTPUT OTR = OUTPUT TRACE R4 00230000 CA 00240000 CA 00250000 CA THIS PROCESS PERFORMS AUTO- AND CROSS-CORRELATIONS 00260000 CA ON SPECIFIED TRACES AND ANALYZES THE SIGNAL SPECTRUM. 00270000 CA 00280000 C SUBROUTINES CALLED: ARADC (S1ATP) 00290000 C ARADCC (S1ATP) 00300000 C ARADF (S1ATP) 00310000 C ARDVF (S1ATP) 00320000 C ARDVFC (S1ATP) 00330000 C ARFLP (S1ATP) 00340000 C ARMPF (S1ATP) 00350000 C ARMVE (S1ATP) 00360000 C ARPOW (S1ATP) 00370000 C ARSBF (S1ATP) 00380000 C ARSET (S1ATP) 00390000 C ARSQRT (S1ATP) 00400000 C COFAPP 00410000 C COFGEN 00420000 C DEVMOD 00430000 C FOIDSD (FOSCDK) 00440000 C FOISSD (FOSCDK) 00450000 C FORC (FOIP) 00460000 C FORDSD (FOSCDK) 00470000 C FORP (FOIP) 00480000 C FOWDSD (FOSCDK) 00490000 C LEGEN1 (THIS FILE) 00500000 C LEGEN2 (THIS FILE) 00510000 C LEGEND (THIS FILE) 00520000 C LOGPLT 00530000 C PLOT 00540000 C PLOTS 00550000 C S1BNCV 00560000 C S2DFT2 00570000 C SYMBOL 00580000 C USPHD 00590000 C UPAWRK 00600000 C UPRESM 00610000 C USDDNV 00620000 C USRTHV 00630000 C USSTHV 00640000 C USSRTC 00650000 C XCORR 00660000 C 00670000 C FUNCTIONS CALLED: COS 00680000 C EXP 00690000 C FLOAT 00700000 C IABS 00710000 C INT 00720000 C LOC 00730000 C MAX0 00740000 C MIN0 00750000 C SQRT 00760000 C S1CPCH 00770000 C 00780000 C EJECT 00790000 C 00800000 C 00810000 C 00820000 C LOCAL OR INTERNAL ARRAYS. 00830000 C 00840000 C (R) MEANS THE VARIABLE IS RESERVED IN DLOCAL 00850000 C (D) MEANS THE VARIABLE IS IN THE PARAMETER RECORD ARRAY 'DENTRY' 00860000 C (C) MEANS THE VARIABLE IS A CONSTANT UNCHANGED BY THE PROGRAM 00870000 C (P) MEANS THE VARIABLE IS AN ELEMENT OF COMMON /P/ 00880000 C 00890000 C 00900000 C (D) DATTR ( 96) = DATA ATTRIBUTES STORAGE I4 00910000 C (R) DDNMO ( 2) = DDNAME FOR OUTPUT DATA SET I4 00920000 C (D) DENTRY ( 104) = PARAMETER STORAGE I4 00930000 C (R) DLOCAL (5000) = LOCAL VARIABLES STORAGE I4 00940000 C (R) WINLEN (2000) = NUMBER OF SAMPLES IN THE STORED TRACE I4 00950000 C (R) WINOFF (2000) = OFFSET OF STORED WINDOW I4 00960000 C (R) WINPNT (2000) = POINTER TO WINDOWS AFTER OFFSET SORT I4 00970000 C (R) DSNAME = DATA SET NAME OF PLOT FILE CHAR*44 00980000 C (R) WRKALO = WORK FILE DYNAMIC ALLOCATION FLAG I4 00990000 C (R) DYNAMF = PLOT FILE DYNAMIC ALLOCATION FLAG I4 01000000 C GRPINT = GROUP INTERVAL IN FEET I4 01010000 C 01020000 C 01030000 C INH ( 1) = INPUT TRACE HEADER I4 01040000 C INTR ( 1) = INPUT TRACE AREA R4 01050000 C OH ( 1) = OUTPUT TRACE HEADER I4 01060000 C OTR ( 1) = OUTPUT TRACE AREA R4 01070000 C 01080000 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 01090000 C 01100000 C (D) DCTYP = VARIABLE FOR TYPE OF SCALING CHAR*4 01110000 C (D) SPT = STARTING POINT I4 01120000 C (D) EPT = ENDING POINT I4 01130000 C (D) NOPAR = NUMBER OF PARAMETERS I4 01140000 C (D) PMODE = PROCESSING MODE I4 01150000 C (D) SPLOCN = SHOT POINT LOCATION: NOT USED AT THIS TIME I4 01160000 C (D) SDPCNT = NUMBER OF SUCCESSIVE SP/DP GROUPS TO COMBINE I4 01170000 C (D) INTTOL = OFFSET INTERVAL ERROR TOLERANCE ALLOWED I4 01180000 C (D) OFFMIN = MINIMUM OFFSET TO PROCESS I4 01190000 C (D) OFFMAX = MAXIMUM OFFSET TO PROCESS I4 01200000 C (D) MXODIF = MAXIMUM TRACE-OFFSET DIFFERENCE TO CROSS-CORR. I4 01210000 C (D) NSTIME = STARTING TIME OF WINDOW FOR ZERO OFFSET I4 01220000 C (D) NETIME = END TIME OF WINDOW FOR ZERO OFFSET I4 01230000 C (D) SNMOV = MOVEOUT VELOCITY AT START TIME I4 01240000 C (D) ENMOV = MOVEOUT VELOCITY AT END TIME I4 01250000 C (D) ANTYPE = ANALYSIS TYPE I4 01260000 C (D) ALTYPE = CROSS-CORRELATION ALIGNMENT TYPE I4 01270000 C (D) SMOOTH = SMOOTHING FILTER TYPE APPLIED TO CORR. BEFORE FFT I4 01280000 C (D) MAXLAG = MAXIMUM TIME LAG OF CORRELATIONS FOR FFT I4 01290000 C (D) ALTIME = WIDTH OF CROSS-CORR ALIGNMENT SEARCH WIDNOW I4 01300000 C (D) PLTYPE = PLOT TYPE I4 01310000 C (D) NORM = NORMALIZATION VALUE OF ZERO-LAG AUTO CORRELATION I4 01320000 C (D) ISHORT = A FLAG SET NON-ZERO FOR DEFAULT SIZE PLOTS 15X9.5 I4 01330000 C 01340000 C (R) OFFSET = ARRAY OF ALLOWED SHOT-RECEIVER TRACE OFFSETS 01350000 C (LESS THAN OFFMAX) 1000I4 01360000 C OFFTEM = SHOT-RECEIVER DISTANCE FROM TRACE HEADER R4 01370000 C (D) OFFDIF = OFFSET DIFFERENCE ARRAY FOR CROSS-CORR. PLOTS 9I4 01380000 C (D) NDIF = NUMBER OF OFFSET DIFFERENCE GROUPS FOR INDIVIDUAL 01390000 C CROSS-CORRELATION PLOTS I4 01400000 C MAXCRO = NUMBER OF OFFSET DIFFERENCE GROUPS USED FOR CROSS 01410000 C CORRELATION. IT IS MAX0( MXODIF,9 ) I4 01420000 C 01430000 C (D) REMARK = ARRAY CONTAINING USER REMARK 45I4 01440000 C 01450000 C (P) KPIRSM = POINTER TO: FIRST WORD OF SDCORA'S RESERVE MEMORY I4 01460000 C (R) SRANGE = FIRST WORD OF PROCESSING RANGE TABLE I4 01470000 C (R) ERANGE = LAST WORD OF PROCESSING RANGE TABLE I4 01480000 C (R) DAT = FIRST WORD OF DISK ADDRESS TABLE I4 01490000 C (R) DATEND = LAST WORD OF DISK ADDRESS TABLE I4 01500000 C (R) LDPAR = FIRST WORD OF CURRENT LOADING PARAMETER STORAGE I4 01510000 C (R) ANPAR = FIRST WORD OF CURRENT ANALYSIS PARAM. STORAGE I4 01520000 C (R) PHEADR = FIRST WORD OF HEADER OF TRACE GROUP BEING ANALD I4 01530000 C (R) WINST = FIRST WORD OF WINDOW STORAGE AREA I4 01540000 C 01550000 C I = ITERATION COUNTER I4 01560000 C K = ITERATION COUNTER I4 01570000 C I9 = ITERATION COUNTER (XCORR ROUTINE) I4 01580000 C J9 = ITERATION COUNTER (XCORR ROUTINE) I4 01590000 C (R) IR = RESERVED ITERATION COUNTER I4 01600000 C 01610000 C (C) LLOCAL = LENGTH OF DLOCAL ( =5000) I4 01620000 C (C) LWIN = LENGTH OF MAX. RESERVE SPACE FOR A WINDOW (1024) I4 01630000 C (C) NRWIN = NUMBER OF TRACE STORAGE AREAS RESERVED (2000) I4 01640000 C (C) COR = CHARACTER STRING 'COR ' CHAR*4 01650000 C (C) PTS = CHARACTER STRING 'PTS ' CHAR*4 01660000 C (C) DEPTHP = CHARACTER STRING 'DEPTH PT' CHAR*4 01670000 C (C) SHOTPT = CHARACTER STRING 'SHOT PT ' CHAR*4 01680000 C (C) IBUFF = MAXIMUM LENGTH FOR CORRELATION BUFFER (2*LWIN-1) I4 01690000 C (C) NFREQ = MAXIMUM NUMBER OF FREQ .GE. 0 FROM FFT I4 01700000 C 01710000 C (R) LEN = MAXIMUM DISK PARAMETER RECORD LENGTH (18+NDIF) 01720000 C PLUS 45 WORDS FOR USER REMARK. LEN ACTUALLY 01730000 C HAS THE VALUE 78 I4 01740000 C (R) THL = TRACE HEADER LENGTH I4 01750000 C (R) TRCLEN = NUMBER OF PROCESSING SAMPLES FROM LINE CARD I4 01760000 C (R) SAMINT = SAMPLING INTERVAL (MILLISECONDS) I4 01770000 C (R) NOWIN = NUMBER OF STORED WINDOWS I4 01780000 C (R) TYPPNT = CHARACTER STRING DESCRIBING TYPE OF GATHER CHAR*4 01790000 C (R) TRCCNT = NUMBER OF TRACES TO ANALYZE I4 01800000 C (R) SPDPCT = NUMBER OF TRACE GROUPS STORED AWAY SO FAR I4 01810000 C (R) SHOT1 = STARTING SP/DP NUMBER OF CURRENT GROUP I4 01820000 C (R) SHOT2 = ENDING SP/DP NUMBER OF CURRENT GROUP I4 01830000 C (R) LSHOT = SP/DP NUMBER OF THE PREVIOUSLY PROCESSED TRACE I4 01840000 C 01850000 C (R) INDFAT = ADDRESS IN RESERVED COMMON FOR PLOT REEL STORAGE I4 01860000 C (R) OPNFLG = FLAG INDICATING PLOTS FILE IS OPEN I4 01870000 C (R) IPLTNO = PLOT NUMBER (# TIMES PLOTS HAS BEEN OPENED) I4 01880000 C (R) PROCFL = FLAG INDICATING A NEW PROCESS I4 01890000 C TPN = TRACE POINT NUMBER I4 01900000 C TICD = TRACE IDENTIFICATION CODE (TYPE OF TRACE) I4 01910000 C NOWDS = NUMBER OF WORDS TO RESERVE I4 01920000 C IC = COUNTER OF NUMBER OF WORDS RESERVED I4 01930000 C (R) DAP = DISK ADDRESS POINTER I4 01940000 C 01950000 C (R) FLGATH = FLAG INDICATING TYPE OF GATHER (SP OR DP) I4 01960000 C (R) FLGDTR = FLAG INDICATING TRACE FROM A NEW GROUP IS STORED I4 01970000 C (R) FLAN = FLAG INDICATING THAT ANALYSIS SHOULD BE DONE I4 01980000 C (R) FLFTT = FLAG INDICATING FIRST TRACE TO PROCESS I4 01990000 C (R) STACK = NUMBER OF HORIZONTALLY STACKED TRACES, ZERO FOR 02000000 C UNSTACKED DATA I4 02010000 C (R) IPLT = FLAG INDICATING WHETHER DEFAULT PLOT SIZE FOR 02020000 C LOGPLT OR SET UP BY AAXIS I4 02030000 C (R) IBYTES = NUMBER OF BYTES DISK RECORD LENGTH MUST BE TO HOLD 02040000 C TRACE WINDOW ON DISK FILE I4 02050000 C (R) NOREC = THE ACTUAL NUMBER OF DISK RECORDS DYNAMICALLY 02060000 C ALLOCATED FOR DIRECT ACCESS DISK FILE I4 02070000 C 02080000 C AUTOFL = FLAG INDICATING AUTO-CORRELATION I4 02090000 C MIDCNT = NUMBER OF LAGS TO CORRELATE WITH SAME # OF MULTS I4 02100000 C CORFST = POINTER INTO ARRAY CORBUF (XCORR ROUTINE) I4 02110000 C LTEMP1 = POINTER TO WORD BEFORE WINDOW TO CORRELATE I4 02120000 C LTEMP2 = POINTER TO WORD BEFORE WINDOW TO CORRELATE I4 02130000 C WINLN1 = LENGTH OF FIRST WINDOW I4 02140000 C WINLN2 = LENGTH OF SECOND WINDOW I4 02150000 C PNTEM1 = TEMPORARY INDEX INTO WINDOW (XCORR ROUTINE) I4 02160000 C PNTEM2 = TEMPORARY INDEX INTO WINDOW (XCORR ROUTINE) I4 02170000 C 02180000 C STIME = STARTING TIME ON OFFSET WINDOW I4 02190000 C ETIME = ENDING TIME ON OFFSET WINDOW I4 02200000 C TEMPO = TEMPORARY VARIABLE I4 02210000 C END = NUMBER OF UNRESERVED WORDS LEFT IN BLANK COMMON I4 02220000 C NYFREQ = NYQUIST FREQUENCY I4 02230000 C RUNTOT = RUNNING TOTAL IN CORRELATION SUMMING (XCORR) R4 02240000 C EXPWIN = ARRAY HOLDING SMOOTHING WEIGHTS TO APPLY TO THE 02250000 C CORRELATIONS PRIOR TO FFT 1024R4 02260000 C MAXCLN = NUMBER OF LAGS TO MAINTAIN IN APPLYING THE SMOOTHING 02270000 C FILTER TO THE CORRELATIONS. IT IS MIN0(1023,SMALLEST 02280000 C MOVED-OUT WINDOW SIZE OF ANALYSIS GROUP) I4 02290000 C 02300000 C CORBUF = HOLDS RESULTS OF CORRELATIONS 2047R4 02310000 C CORSCL = ARRAY HOLDING THE DIVISION FACTOR NEEDED TO PROPERLY 02320000 C NORMALIZE THE ZERO-LAG AUTO-CORRELATION VALUE 2000R4 02330000 C SCLCOR = DIVISION SCALE FACTOR FOR CROSS-CORRELATION SO AS TO 02340000 C NORMALIZE ACCORDING TO THE AUTO-CORRELATION R4 02350000 C SCLFAC = DIVISION SCALE FACTOR FOR THE FFT OF CROSS- 02360000 C CORRELATION. NORMALLY SCLFAC IS SAME AS SCLCOR. IF 02370000 C NORM=0, SCLFAC=1.0 IN ORDER TO PRODUCE UNNORMALIZED 02380000 C OR "RAP" SPECTRA WITH THE FFT R4 02390000 C CORMAX = MAXIMUM VALUE IN THE CORRELATION OF THE CROSS- 02400000 C CORRELATION WITH THE AUTO-CORRELATION R4 02410000 C XCOEFF = CROSS-CORRELATION COEFF. FOR A GIVEN OFFSET 02420000 C DIFFERENCE WITH UNIT NORMALIZATION OF THE ZERO-LAG 02430000 C AUTO-CORRELATION VALUE R4 02440000 C TCOEFF = TOTAL CROSS-CORRELATION COEFF. FOR ALL OFFSET 02450000 C DIFFERENCES WITH UNIT NORMALIZATION OF THE ZERO- 02460000 C LAG AUTO-CORRELATION VALUE (FOR BOTH FORWARD AND 02470000 C OPPOSITE CROSS-CORRELATIONS) R4 02480000 C XCRANV = ACTUAL CROSS-CORRELATION COEFF. AT CENTER LAG OF 02490000 C ALIGNED CROSS-CORRELATIONS ASSUMING UNIT NORMALI- 02500000 C ZATION FOR ZERO-LAG AUTO-CORRELATION (INCLUDING BOTH 02510000 C FORWARD AND OPPOSITE CROSS-CORRELATIONS) R4 02520000 C 02530000 C CRANUT = ARRAY KEEPING TOTAL AUTO-CORRELATIONS 2047R4 02540000 C CRANV = ARRAY KEEPING TOTAL FORWARD CROSS-CORRELATIONS FOR A 02550000 C GIVEN OFFSET DIFFERENCE GROUP 2047R4 02560000 C CRANV2 = ARRAY KEEPING TOTAL OPPOSITE CROSS-CORRELATIONS FOR A 02570000 C GIVEN OFFSET DIFFERENCE GROUP 2047R4 02580000 C CORRX1 = ARRAY KEEPING TOTAL FORWARD CROSS-CORRELATIONS FOR ALL 02590000 C OFFSET DIFFERENCE GROUPS 2047R4 02600000 C CORRX2 = ARRAY KEEPING TOTAL OPPOSITE CROSS-CORRELATIONS FOR ALL 02610000 C OFFSET DIFFERENCE GROUPS 2047R4 02620000 C 02630000 C FFTEM = ARRAY WHICH SERVES AS INPUT&OUTPUT TO FFT ROUTINE. 02640000 C FFT LENGTH IS SET TO BE NO MORE THAN 2048. FFTEM MUST 02650000 C BE TWO WORDS LONGER THAN FFT FOR COMPLEX VALUE AT 02660000 C ZERO FREQUENCY. 2050R4 02670000 C FFTBUF = MULTI-DIMENSIONED ARRAY STORING AMPLITUDE SPECTRUM, 02680000 C CROSS-POWER SPECTRUM, AND STANDARD DEVIATION. THE 02690000 C CROSS SPECTRUM USES COLS.5 AND 6 BECAUSE OF COMPLEX 02700000 C NATURE OF THE CROSS POWER FFT. (1025,6)R4 02710000 C FFTAVC = ARRAY IN WHICH FIRST COLUMN STORES AVE. AUTO 02720000 C POWER SPECTRUM; THE I TH COLUMN STORES AVE. CROSS 02730000 C POWER SPECTRUM FOR (I-1) TH OFFSET DIFFERENCE 02740000 C GROUP (1025,10)R4 02750000 C FFTAVP = ARRAY IN WHICH FIRST COLUMN STORES AVE. AUTO 02760000 C AMPL. SPECTRUM; THE I TH COLUMN STORES AVE. AMPLITUDE 02770000 C SPECTRUM FOR (I-1) TH OFFSET DIFFERENCE 02780000 C GROUP (1025,10)R4 02790000 C FFTSUM = STORES THE TOTAL CROSS-POWER SPECTRUM FOR ALL 02800000 C OFFSET DIFFERENCE GROUPS (A RUNNING SUM) 1025R4 02810000 C SIGRAT = ARRAY IN WHICH FIRST COLUMN STORES THE RATIO OF 02820000 C THE AVE. POWER TO THE STD. DEVIATION; THE I TH 02830000 C COLUMN HOLDS THE RATIO OF THE AVE. SIGNAL POWER 02840000 C FOR THE (I-1) TH OFFSET DIFFERENCE GROUP TO THE 02850000 C STD. DEVIATION (1025,11)R4 02860000 C 02870000 C 02880000 C EJECT 02890000 C 02900000 C 02910000 C=======================================================================02920000 C 02930000 C 02940000 C FORMAT OF PARAMETER RECORDS 02950000 C 02960000 C ****** FIRST RECORDS ****** PROCESSING RANGES ****** 02970000 C 02980000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 02990000 C |_______|________|_______|_______|_______|_______|_|_|_____|_______| 03000000 C | CORA | INVOC. | PTS | NOT | NOT | # OF |N|P| NOT | NOT | 03010000 C |_______|_NUMBER_|_______|__USED_|__USED_|_PARMS_|_|M|_USED|__USED_| 03020000 C 03030000 C WORD 9 WORD 10 03040000 C |_______|________| 03050000 C | START | END | 03060000 C |S/D_PT_|_S/D_PT_| 03070000 C . . . 03080000 C . . . 03090000 C . . . 03100000 C WORD 103WORD 104 03110000 C |_______|________| 03120000 C | START | END | 03130000 C |S/D_PT_|_S/D_PT_| 03140000 C 03150000 C EJECT 03160000 C 03170000 C ****** COR RECORD ****** SELECTION PARAMETERS ****** 03180000 C 03190000 C WORD 1 WORD 2 WORD 3 WORD 4 WORD 5 WORD 6 WORD 7 WORD 8 03200000 C |_______|_______|_______|_______|_______|_______|_|_|____|______| 03210000 C | CORA |INVOC. | COR | START | END | # OF |N|P|NOT |SP/DP | 03220000 C |_______|NUMBER_|_______|SP_/_DT|SP_/_DP|_PARMS_|_|M|USED|LOCATN| 03230000 C 03240000 C WORD 9 WORD 10 WORD 11 WORD 12 WORD 13 WORD 14 WORD 15 WORD 16 03250000 C |_______|_______|_______|_______|_______|_______|_______|_______| 03260000 C |SP_/DP_|INTERVL|MINIMUM|MAXIMUM|MAX OFF| START | END | START | 03270000 C |GROUPS_|TOLERNC|OFFSET_|OFFSET_|DIFFRNC|__TIME_|__TIME_|NMO_VEL| 03280000 C 03290000 C WORD 17 WORD 18 WORD 19 WORD 20 WORD 21 WORD 22 WORD 23 WORD 24 03300000 C |_______|_______|_______|_______|_______|_______|_______|_______| 03310000 C | END | ANAL | ALIGN |SMOOTHE|MAX COR| ALIGN | PLOT | NORM | 03320000 C |NMO_VEL|__TYPE_|__TYPE_|FILTER_|__LAG__|_RANGE_|_TYPE__|'0'LAG_| 03330000 C 03340000 C WORD 25 WORD 26 WORD 27 WORD 28 WORD 29 WORD 30 03350000 C |_______|______|_______|_______|_______|_______| 03360000 C |ISHORT |ITAPER| XMCOR | MAXFRQ| GRID |ABS NRM| 03370001 C |_______|______|_______|TO_PLOT|_______|SCL_FAC| 03380001 C 03390000 C WORD 31 WORD 32 ................WORD (31+NDIF) 03400000 C |_______|_______|_______|............|_________| 03410000 C |NUM DIF|OFF DIF|OFF DIF|............|OFF DIF | 03420000 C |TO_PLOT|PLOT_1_|PLOT_2_|............|PLOT_NDIF| 03430000 C 03440000 C WORD 41 ....... WORD 85 WORD 86 .... WORD 104 03450000 C |_______________________|______ |.... |_______| 03460000 C |REMARK CARDS (45 WORDS)| NOT |.... | NOT | 03470000 C |_______________________|__USED_|.... |__USED_| 03480000 C 03490000 C 03500000 C EJECT 03510000 C 03520000 C ==================================================================== 03530000 C 03540000 C 03550000 C 03560000 C LAYOUT OF BLANK COMMON 03570000 C 03580000 C ________________________________ 03590000 C KPIRSM --> | "LLOCAL" WORDS FOR | 03600000 C | LOCAL VARIABLES | 03610000 C | ("DLOCAL") | 03620000 C | | 03630000 C |______________________________| 03640000 C KIIRSM + LLOCAL --> | TABLE OF INTERPOLATION | 03650000 C | COEFFICIENTS GENERATED | 03660000 C | BY COFGEN (600) | 03670000 C | . | 03680000 C | . | 03690000 C |______________________________| 03700000 C SRANGE --> | STARTING AND ENDING SHOT | 03710000 C | POINTS TO BE PROCESSED | 03720000 C | . | 03730000 C | . | 03740000 C ERANGE --> |______________________________| 03750000 C DAT --> | DISK ADDRESS POINTER TABLE | 03760000 C | FOR PARAMETER RECORDS | 03770000 C | . | 03780000 C | . | 03790000 C DATEND --> |______________________________| 03800000 C LDPAR --> | TABLE OF PARAMETERS FOR | 03810000 C | THE TRACE BEING LOADED | 03820000 C | . | 03830000 C | . | 03840000 C | . | 03850000 C |______________________________| 03860000 C ANPAR --> | TABLE OF PARAMETERS FOR | 03870000 C | THE TRACE GROUP BEING | 03880000 C | ANALYZED | 03890000 C | . | 03900000 C | . | 03910000 C |______________________________| 03920000 C PHEADR --> | STORAGE FOR HEADER OF THE | 03930000 C | TRACE GROUP BEING ANALYZED | 03940000 C | . | 03950000 C | . | 03960000 C |______________________________| 03970000 C WINST --> | WINDOWS SAVED FROM THE | 03980000 C | TRACES WITHIN A SINGLE | 03990000 C | ANALYSIS GROUP | 04000000 C | (TWO TRACES ONLY ARE KEPT) | 04010000 C | . | 04020000 C | . | 04030000 C | ________________ | 04040000 C | | 04050000 C | ________________ | 04060000 C | . | 04070000 C | . | 04080000 C | ________________ | 04090000 C | FIRST WINDOW | 04100000 C | OF NEXT GROUP | 04110000 C | ________________ | 04120000 C | . | 04130000 C | . | 04140000 C |______________________________| 04150000 C 04160000 C ===================================================================== 04170000 C 04180000 C EJECT 04190000 C 04200000 C 04210000 C COMMENT NOTATION: 04220000 C 04230000 C | 04240000 C |C IS JUST A SPACER TO IMPROVE READABILITY 04250000 C |C *** INDICATES A COMMENT DESCRIBING THE FOLLOWING CODE 04260000 C |CCH CODE THAT PRINTS OUT DIAGNOSTIC INFORMATION 04270000 C |CCH FOR DEBUGGING PURPOSES. IT HAS BEEN RETAINED, 04280000 C |CCH BUT COMMENTED IN, SO THAT CHECKS CAN EASILY 04290000 C |CCH BE IMPLEMENTED WHENEVER NECESSARY. 04300000 C | 04310000 C 04320000 C 04330000 C 04340000 SUBROUTINE SDCORA (INH,INTR,OH,OTR) 04350000 C 04360000 IMPLICIT INTEGER (A-Z) 04370000 C 04380000 C SET UP PARAMETER STATEMENT TO DEFINE ARRAY LENGTH OF DLOCAL, 04390000 C THE NUMBER OF SAMPLES ALLOWED IN WINDOW, THE NUMBER OF TRACES 04400000 C IN ONE ANALYSIS GROUP, AND THE LARGEST NUMBER OF TRACE OFFSETS. 04410000 C 04420000 C WITH THIS PARAMETER STATEMENT ARRAY DIMENSIONS CAN BE CHANGED 04430000 C BY SIMPLY MODIFYING THIS ONE STATEMENT. 04440000 C 04450000 PARAMETER (LLOCAL= 200,LWIN=1024,NRWIN=2000,NROFF=1000) 04460000 C 04470000 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 5/07/87 04480000 COMMON /P/ STARTP ( 2) 04490000 COMMON /P/ LCNAME 04500000 COMMON /P/ LC5 04510000 COMMON /P/ LCINT 04520000 COMMON /P/ LCTYP , M00020 04530000 COMMON /P/ LCBGSP 04540000 COMMON /P/ LCENSP , M00032( 2) 04550000 COMMON /P/ LCNSP 04560000 COMMON /P/ LCTPSP 04570000 COMMON /P/ LCRL 04580000 COMMON /P/ LCSI 04590000 COMMON /P/ LCPI 04600000 COMMON /P/ LCGRPI 04610000 COMMON /P/ LCMXFD , M00068( 2) 04620000 COMMON /P/ LCDRYF , M00080( 3) 04630000 COMMON /P/ ACNAME 04640000 COMMON /P/ AC0506 04650000 COMMON /P/ AC64BC 04660000 COMMON /P/ ACOPCD 04670000 COMMON /P/ ACQCF 04680000 COMMON /P/ ACDIST 04690000 COMMON /P/ ACPROJ 04700000 COMMON /P/ ACLNAM ( 5) 04710000 COMMON /P/ ACCOM ( 8) , M00144 04720000 COMMON /P/ ACTYPE 04730000 COMMON /P/ ACNSP 04740000 COMMON /P/ ACUSER ( 5) , M00188( 12) 04750000 COMMON /P/ LHJBNO 04760000 COMMON /P/ LHLNO 04770000 COMMON /P/ LHRLNO 04780000 COMMON /P/ LHTPSP 04790000 COMMON /P/ LHATSP 04800000 COMMON /P/ LHSI 04810000 COMMON /P/ LHORSI 04820000 COMMON /P/ LHST 04830000 COMMON /P/ LHORST 04840000 COMMON /P/ LHDFCD 04850000 COMMON /P/ LHEXFD 04860000 COMMON /P/ LHTSCD 04870000 COMMON /P/ LHVSCD 04880000 COMMON /P/ LHSWFS 04890000 COMMON /P/ LHSWFE 04900000 COMMON /P/ LHSWL 04910000 COMMON /P/ LHSWCD 04920000 COMMON /P/ LHTSNO 04930000 COMMON /P/ LHSWTS 04940000 COMMON /P/ LHSWTE 04950000 COMMON /P/ LHSWTT 04960000 COMMON /P/ LHTCF 04970000 COMMON /P/ LHBGRF 04980000 COMMON /P/ LHARCD 04990000 COMMON /P/ LHMS 05000000 COMMON /P/ LHSGPL 05010000 COMMON /P/ LHVPCD 05020000 COMMON /P/ LHNSP 05030000 COMMON /P/ LHNDP 05040000 COMMON /P/ LHNSL 05050000 COMMON /P/ LHMTPR , M00376( 9) 05060000 COMMON /P/ KPNA 05070000 COMMON /P/ KPRNO , M00420 05080000 COMMON /P/ KPA 05090000 COMMON /P/ KPDBGS 05100000 COMMON /P/ KPDBGA 05110000 COMMON /P/ KPDBGN 05120000 COMMON /P/ KPWRKS 05130000 COMMON /P/ KPWRKD 05140000 COMMON /P/ KPWKS2 05150000 COMMON /P/ KPWKD2 , M00456( 2) 05160000 COMMON /P/ KPFCF 05170000 COMMON /P/ KPIRSM 05180000 COMMON /P/ KPNRSM 05190000 COMMON /P/ KPIUSM 05200000 COMMON /P/ KPNUSM 05210000 COMMON /P/ KPTIME 05220000 COMMON /P/ KPRTF 05230000 COMMON /P/ KPDRTF 05240000 COMMON /P/ KPMOTF 05250000 COMMON /P/ KPNBR 05260000 COMMON /P/ KPIBN 05270000 COMMON /P/ KPITSV 05280000 COMMON /P/ KPTAMF 05290000 COMMON /P/ KPLOTF 05300000 COMMON /P/ KPMITF 05310000 COMMON /P/ KPPRNT 05320000 COMMON /P/ KPPLOT 05330000 COMMON /P/ KPPLTA 05340000 COMMON /P/ KPBUGF 05350000 COMMON /P/ KPWARN 05360000 COMMON /P/ KPTRIO 05370000 COMMON /P/ KPWKIO 05380000 COMMON /P/ KPVOLS , M00556( 2) 05390000 COMMON /P/ KPDSNS , M00568( 141) 05400000 COMMON /P/ MCCOLR , M01136( 38) 05410000 COMMON /P/ PTTBLK , M01292 05420000 COMMON /P/ PTFATL , M01300( 2) 05430000 COMMON /P/ PTTHL , M01312( 31) 05440000 COMMON /P/ PROTAB ( 2) 05450000 COMMON /P/ ENDP 05460000 C 05470000 REAL LCGRPI 05480000 C 05490000 C 05500000 C 05510000 C=================================================================== 05520000 C 05530000 C BLANK COMMON DEFINITION 05540000 C 05550000 COMMON COM (1) 05560000 REAL XCOM(1) 05570000 EQUIVALENCE (COM(1),XCOM(1)) 05580000 C 05590000 C=================================================================== 05600000 C 05610000 C REAL ARRAYS IN PARAMETER LIST. 05620000 C 05630000 REAL INTR(1) 05640000 REAL OTR (1) 05650000 C 05660000 C INTEGER ARRAYS IN PARAMETER LIST. 05670000 C 05680000 INTEGER INH(1) 05690000 INTEGER OH (1) 05700000 C 05710000 C=================================================================== 05720000 C 05730000 C INTEGER ARRAYS--LOCAL 05740000 C 05750000 INTEGER DDNMO ( 2) 05760000 INTEGER DLOCAL (LLOCAL) 05770000 INTEGER DENTRY (104) 05780000 INTEGER DATTR (96) 05790000 INTEGER OFFDIF ( 9) 05800000 INTEGER REMARK (15,3) 05810000 INTEGER TDUMM (4) 05820000 C 05830000 C=================================================================== 05840000 C 05850000 C REAL ARRAYS--LOCAL 05860000 C 05870000 REAL XDATTR (96) 05880000 EQUIVALENCE (XDATTR(1), DATTR(1)) 05890000 C 05900000 REAL DATE (2) 05910000 REAL TIME (2) 05920000 C 05930000 C=================================================================== 05940000 C 05950000 C PARAMETER RECORD ENTRY ARRAY EQUIVALENCES 05960000 C 05970000 EQUIVALENCE (DCTYP ,DENTRY (03)) 05980000 EQUIVALENCE (SPT ,DENTRY (04)) 05990000 EQUIVALENCE (EPT ,DENTRY (05)) 06000000 EQUIVALENCE (NOPAR ,DENTRY (06)) 06010000 EQUIVALENCE (PMODE ,DENTRY (07)) 06020000 EQUIVALENCE (SPLOCN ,DENTRY (08)) 06030000 EQUIVALENCE (DATTR(1) ,DENTRY (09)) 06040000 EQUIVALENCE (XDATTR(1) ,DENTRY (09)) 06050000 C 06060000 C 06070000 C 06080000 C=================================================================== 06090000 C 06100000 C DLOCAL - LOCAL VARIABLE EQUIVALENCES 06110000 C 06120000 EQUIVALENCE (SDPCNT ,DLOCAL (001)) 06130000 EQUIVALENCE (INTTOL ,DLOCAL (002)) 06140000 EQUIVALENCE (OFFMIN ,DLOCAL (003)) 06150000 EQUIVALENCE (OFFMAX ,DLOCAL (004)) 06160000 EQUIVALENCE (MXODIF ,DLOCAL (005)) 06170000 EQUIVALENCE (NSTIME ,DLOCAL (006)) 06180000 EQUIVALENCE (NETIME ,DLOCAL (007)) 06190000 EQUIVALENCE (SNMOV ,DLOCAL (008)) 06200000 EQUIVALENCE (ENMOV ,DLOCAL (009)) 06210000 EQUIVALENCE (ANTYPE ,DLOCAL (010)) 06220000 EQUIVALENCE (ALTYPE ,DLOCAL (011)) 06230000 EQUIVALENCE (SMOOTH ,DLOCAL (012)) 06240000 EQUIVALENCE (MAXLAG ,DLOCAL (013)) 06250000 EQUIVALENCE (ALTIME ,DLOCAL (014)) 06260000 EQUIVALENCE (PLTYPE ,DLOCAL (015)) 06270000 EQUIVALENCE (NORM ,DLOCAL (016)) 06280000 EQUIVALENCE (ISHORT ,DLOCAL (017)) 06290000 EQUIVALENCE (ITAPER ,DLOCAL (018)) 06300000 EQUIVALENCE (XMCOR ,DLOCAL (019)) 06310000 EQUIVALENCE (MAXFRQ ,DLOCAL (020)) 06320000 EQUIVALENCE (GRIDSW ,DLOCAL (021)) 06330000 EQUIVALENCE (ANRMSF ,DLOCAL (022)) 06340001 EQUIVALENCE (NDIF ,DLOCAL (023)) 06350000 EQUIVALENCE (OFFDIF(1) ,DLOCAL (024)) 06360000 EQUIVALENCE (REMARK(1,1),DLOCAL(033)) 06370000 C 06380000 EQUIVALENCE (SRANGE ,DLOCAL (091)) 06390000 EQUIVALENCE (ERANGE ,DLOCAL (092)) 06400000 EQUIVALENCE (DAT ,DLOCAL (093)) 06410000 EQUIVALENCE (DATEND ,DLOCAL (094)) 06420000 EQUIVALENCE (SHOT1 ,DLOCAL (095)) 06430000 EQUIVALENCE (SHOT2 ,DLOCAL (096)) 06440000 EQUIVALENCE (PHEADR ,DLOCAL (097)) 06450000 EQUIVALENCE (WINLEN ,DLOCAL (098)) 06460000 EQUIVALENCE (WINOFF ,DLOCAL (099)) 06470000 EQUIVALENCE (WINPNT ,DLOCAL (100)) 06480000 EQUIVALENCE (WINSDP ,DLOCAL (101)) 06490000 EQUIVALENCE (OFFSET ,DLOCAL (102)) 06500000 EQUIVALENCE (INDFAT ,DLOCAL (103)) 06510000 EQUIVALENCE (TRCSAV ,DLOCAL (104)) 06520000 C 06530000 EQUIVALENCE (THL ,DLOCAL (111)) 06540000 EQUIVALENCE (TRCLEN ,DLOCAL (112)) 06550000 EQUIVALENCE (NOSAMP ,DLOCAL (113)) 06560000 EQUIVALENCE (SAMINT ,DLOCAL (114)) 06570000 EQUIVALENCE (GRPINT ,DLOCAL (115)) 06580000 EQUIVALENCE (FLGATH ,DLOCAL (116)) 06590000 EQUIVALENCE (TYPPNT(1) ,DLOCAL (117)) 06600000 C 06610000 EQUIVALENCE (IR ,DLOCAL (121)) 06620000 EQUIVALENCE (NOWIN ,DLOCAL (122)) 06630000 EQUIVALENCE (FLAN ,DLOCAL (123)) 06640000 EQUIVALENCE (SPDPCT ,DLOCAL (124)) 06650000 EQUIVALENCE (IPLTNO ,DLOCAL (125)) 06660000 EQUIVALENCE (TRCCNT ,DLOCAL (126)) 06670000 EQUIVALENCE (DAWRK ,DLOCAL (127)) 06680000 EQUIVALENCE (CORMSG ,DLOCAL (128)) 06690000 EQUIVALENCE (NS ,DLOCAL (129)) 06700000 EQUIVALENCE (TNS ,DLOCAL (130)) 06710000 C 06720000 EQUIVALENCE (FLOTPT ,DLOCAL (131)) 06730000 EQUIVALENCE (OPNFLG ,DLOCAL (132)) 06740000 EQUIVALENCE (PROCFL ,DLOCAL (133)) 06750000 EQUIVALENCE (STACK ,DLOCAL (134)) 06760000 EQUIVALENCE (DIST ,DLOCAL (135)) 06770000 EQUIVALENCE (IPLT ,DLOCAL (136)) 06780000 EQUIVALENCE (NOFF ,DLOCAL (137)) 06790000 EQUIVALENCE (LSHOT ,DLOCAL (138)) 06800000 C 06810000 EQUIVALENCE (WRKALO ,DLOCAL (141)) 06820000 EQUIVALENCE (DYNAMF ,DLOCAL (142)) 06830000 EQUIVALENCE (DDNMO ,DLOCAL (143)) 06840000 EQUIVALENCE (DSNAME ,DLOCAL (145)) 06850000 C 06860000 EQUIVALENCE (PSHOT(1) ,DLOCAL (161)) 06870000 C 06880000 C=================================================================== 06890000 C CHARACTER CONSTANTS 06900000 C=================================================================== 06910000 C 06920000 CHARACTER*8 AVGPOW 06930000 CHARACTER*8 GAUSS 06940000 CHARACTER*8 BLANKS 06950000 CHARACTER*8 DDNAME 06960000 CHARACTER*80 CARD 06970000 CHARACTER*8 DEPTHP 06980000 CHARACTER*8 SHOTPT 06990000 CHARACTER*44 TMPDSN 07000000 CHARACTER*8 PRMODE 07010000 C 07020000 C=================================================================== 07030000 C LOGICAL CONSTANTS 07040000 C=================================================================== 07050000 C 07060000 LOGICAL GRID 07070000 C 07080000 C=================================================================== 07090000 C LOCAL INTEGER CONSTANTS AND ARRAYS 07100000 C=================================================================== 07110000 C 07120000 INTEGER PNUMP (11) 07130000 INTEGER ITYPE (11) 07140000 INTEGER TYPPNT ( 2) 07150000 INTEGER DSNAME (11) 07160000 INTEGER PSHOT (24) 07170000 INTEGER ONE 07180000 INTEGER TWO 07190000 INTEGER THREE 07200000 INTEGER FOUR 07210000 INTEGER FIVE 07220000 INTEGER PTS 07230000 INTEGER COR 07240000 INTEGER DCTYP 07250000 C 07260000 C=================================================================== 07270000 C LOCAL REAL VARIABLES 07280000 C===================================================================== 07290000 C 07300000 REAL AMPREC 07310000 REAL ANG 07320000 REAL ANRMSF 07330001 REAL CORMAX 07340000 REAL DF 07350000 REAL DIF 07360000 REAL DIST 07370000 REAL FLGRPI 07380000 REAL FPSPT 07390000 REAL FPEPT 07400000 REAL FRAC 07410000 REAL GRPINT 07420000 REAL THETA 07430000 REAL SHFT 07440000 REAL SMF 07450000 REAL SMX 07460000 REAL XFACT 07470000 REAL XMAX 07480000 REAL XMCOR 07490000 REAL XMX 07500000 REAL CS 07510000 REAL SS 07520000 REAL YWIDTH 07530000 C 07540000 REAL CFALOG 07550000 REAL TOTLOG 07560000 REAL SCF 07570000 REAL SCF2 07580000 REAL SR 07590000 REAL AVGP 07600000 REAL XFA 07610000 REAL PI 07620000 REAL TWOPI 07630000 REAL LOWBND 07640000 REAL UPPBND 07650000 REAL ALGNFC 07660000 REAL NRAT 07670000 REAL TEMPR1 07680000 REAL TEMPOR 07690000 REAL SCLFAC 07700000 REAL SCL1 07710000 REAL SCLCOR 07720000 REAL XCOEFF 07730000 REAL TCOEFF 07740000 REAL XCRANV 07750000 REAL AAXIS (6) 07760000 C 07770000 CHARACTER*64 DASH 07780000 CHARACTER*64 COMMA 07790000 CHARACTER*64 LABELX 07800000 CHARACTER*64 LABELY 07810000 CHARACTER*8 LABELL (15) 07820000 CHARACTER*128 LABELT 07830000 C CHARACTER*64 LABEL0 07840000 CHARACTER*64 LABEL1 07850000 CHARACTER*64 LABEL2 07860000 CHARACTER*64 LABEL3 07870000 CHARACTER*64 LABEL4 07880000 CHARACTER*64 LABEL5 07890000 CHARACTER*64 LABEL6 07900000 CHARACTER*64 LABE66 07910000 CHARACTER*64 LABEL7 07920000 CHARACTER*64 LABEL8 07930000 CHARACTER*64 LABEL9 07940000 C 07950000 C CONSTANTS INITIALIZATION 07960000 C 07970000 PARAMETER (MRES=100,MSCWID=7040) 07980000 C 07990000 DATA ONE / 1 / 08000000 DATA TWO / 2 / 08010000 DATA THREE / 3 / 08020000 DATA FOUR / 4 / 08030000 DATA FIVE / 5 / 08040000 DATA PTS /'PTS '/ 08050000 DATA COR /'COR '/ 08060000 C 08070000 DATA PI / 3.1415926 / 08080000 DATA TWOPI / 6.2831853 / 08090000 DATA LOWBND / 0.00002 / 08100000 DATA UPPBND / 9.9 / 08110000 DATA ALGNFC / 0.15 / 08120000 C 08130000 DATA AVGPOW / 'AVG '/ 08140000 DATA GAUSS / 'G.N. '/ 08150000 DATA BLANKS / ' '/ 08160000 DATA DEPTHP / 'DEPTH PT'/ 08170000 DATA SHOTPT / 'SHOT PT'/ 08180000 C 08190000 DATA DASH 08200000 * /' - '/ 08210000 DATA COMMA 08220000 * /', '/ 08230000 DATA LABELX 08240000 * /'FREQUENCY '/ 08250000 DATA LABELY 08260000 * /'POWER '/ 08270000 DATA LABELL 08280000 * /15*' '/ 08290000 C DATA LABEL0 08300000 C * /'ACORXCORRCOR '/ 08310000 DATA LABEL1 08320000 * /'CORR. SPECTRUM: OFFSET CORR. '/ 08330000 DATA LABEL2 08340000 * /'AVERAGE CROSS-CORRELATION SPECTRA '/ 08350000 DATA LABEL3 08360000 * /'POWER AUTO CORR TRACES CROSS CORR TRACES'/ 08370000 DATA LABEL4 08380000 * /' WINDOW XXXX MS TO XXXX MS'/ 08390000 DATA LABEL5 08400000 * /'AVERAGED SPECTRAL MAGNITUDES'/ 08410000 DATA LABEL6 08420000 * /'DIFFERENCE BETWEEN AUTO SPECTRUM AND THE CROSS POWER SPECTRA'/08430000 DATA LABE66 08440000 * /'DIFFERENCE BETWEEN AUTO SPECTRUM AND THE AVG OFFSET SPECTRA'/08450000 DATA LABEL7 08460000 * /'RATIO OF AVG. SIGNAL POWER TO STD. DEV. '/ 08470000 DATA LABEL8 08480000 * /'ESTIMATED SIGNAL-TO-NOISE RATIO '/ 08490000 DATA LABEL9 08500000 * /'AVERAGE AUTO, CROSS POWER SPECTRA: '/ 08510000 C 08520000 C =============================================================== 08530000 C INITIALIZATION 08540000 C =============================================================== 08550000 C 08560000 C CHECK IF FIRST TIME THROUGH 08570000 C 08580000 IF ( KPFCF .EQ. 0 ) GO TO 100 08590000 C 08600000 C MAKE SURE THE INPUT IS A TRACE 08610000 C 08620000 CALL USRTHV (INH,'THTICD ',TICD) 08630000 IF ( TICD .NE. 1 ) GO TO 1000 08640000 C 08650000 IF (1.EQ.2) CALL SACOR2 08660000 C 08670000 C ==================================================================== 08680000 C FIRST TIME THROUGH: RESET FLAG 08690000 C ==================================================================== 08700000 C 08710000 KPFCF = 0 08720000 IPLTNO = 0 08730000 PROCFL = 0 08740000 OPNFLG = 0 08750000 KPTRIO = 0 08760000 WRKALO = 0 08770000 DYNAMF = 0 08780000 C 08790000 C ==================================================================== 08800000 C PRINT PROCESS HEADING 08810000 C ==================================================================== 08820000 C 08830000 CALL USPHD (2, ACLNAM, KPNA, KPRNO, 0, 0, KPPRNT) 08840000 C 08850000 C ==================================================================== 08860000 C GET LOCAL MEMORY REQUIREMENTS 08870000 C ==================================================================== 08880000 C 08890000 NOWDS = LLOCAL 08900000 CALL UPRESM (NOWDS) 08910000 IF ( NOWDS .EQ. 0 ) GO TO 1910 08920000 C 08930000 CALL ARSET (DLOCAL, LLOCAL, 0) 08940000 C 08950000 C ==================================================================== 08960000 C RETRIEVE TRACE HEADER VALUES 08970000 C ==================================================================== 08980000 C 08990000 CALL USRTHV (INH, 'THL ', THL) 09000000 CALL USRTHV (INH, 'THNS ', NOSAMP) 09010000 CALL USRTHV (INH, 'THSI ', SAMINT) 09020000 TRCLEN = NOSAMP+THL 09030000 SAMINT = SAMINT / 1000 09040000 SR = SAMINT * 0.001 09050000 GRPINT = LCGRPI 09060000 C 09070000 C CHECK THE HEADER FOR STACKED TRACES 09080000 C 09090000 CALL USRTHV (INH, 'THNHST ', STACK) 09100000 C 09110000 IC = KPIUSM 09120000 END = KPIUSM + KPNUSM -1 09130000 C 09140000 C ==================================================================== 09150000 C READ THE PROCESSING RANGES 09160000 C ==================================================================== 09170000 C 09180000 SRANGE = IC 09190000 DAP = 1 09200000 NOPT= 0 09210000 C 09220000 10 CALL FORP (KPNA, KPRNO, DAP, 104, DENTRY, * 15 ) 09230000 IF (DCTYP .NE. PTS) GO TO 10 09240000 C 09250000 IF ( IC+NOPAR .GT. END ) GO TO 1910 09260000 C 09270000 DO 12 I = 1,NOPAR,2 09280000 TRNG = IABS(DATTR(I+1)-DATTR(I+0))+1 09290000 IF ( TRNG.GT.NOPT ) NOPT=TRNG 09300000 12 CONTINUE 09310000 C 09320000 CALL ARMVE (DATTR, COM(IC), NOPAR) 09330000 IC = IC + NOPAR 09340000 ERANGE = IC - 1 09350000 C 09360000 GO TO 10 09370000 C 09380000 C ==================================================================== 09390000 C DETERMINE THE TYPE OF GATHER 09400000 C ==================================================================== 09410000 C 09420000 15 CONTINUE 09430000 C 09440000 IF (S1CPCH(PMODE,2,'S',1,1) .EQ. 0) THEN 09450000 FLGATH = 1 09460000 STACK = 0 09470000 CALL S1MVCH (SHOTPT,1,TYPPNT,1,8) 09480000 C 09490000 ELSE 09500000 C 09510000 FLGATH = 0 09520000 CALL S1MVCH (DEPTHP,1,TYPPNT,1,8) 09530000 C 09540000 END IF 09550000 C 09560000 C =================================================================== 09570000 C BUILD DISK ADDRESS TABLES 09580000 C =================================================================== 09590000 C 09600000 DAT = IC 09610000 DAP = 1 09620000 FLOTPT = 0 09630000 NOPT = 0 09640000 C 09650000 20 CALL FORP (KPNA, KPRNO, DAP,104, DENTRY, * 30 ) 09660000 IF (DCTYP .NE. COR) GO TO 20 09670000 C 09680000 IF (IC+2 .GT. END) GO TO 1910 09690000 IF ( IABS(DATTR(10)) .EQ. 1 ) FLOTPT = 1 09700000 IJOIN = DATTR(1) 09710000 IF(IJOIN.LE.0) IJOIN=1 09720000 IF(STACK.NE.0) IJOIN=IABS(EPT-SPT)+1 09730000 IRECS = IJOIN 09740000 IF ( IRECS.GT.NOPT ) NOPT=IRECS 09750000 COM(IC) = DAP - 1 09760000 COM(IC+1) = SPT 09770000 IC = IC + 2 09780000 C 09790000 GO TO 20 09800000 C 09810000 30 CONTINUE 09820000 C 09830000 DATEND = IC-1 09840000 C 09850000 C SET ASIDE ROOM FOR OTHER RESERVED AREAS 09860000 C 09870000 PHEADR= IC 09880000 IC = IC + THL 09890000 TRCSAV= IC 09900000 IC = IC + TRCLEN 09910000 WINLEN = IC 09920000 IC = IC + 2000 09930000 WINOFF = IC 09940000 IC = IC + 2000 09950000 WINPNT = IC 09960000 IC = IC + 2000 09970000 WINSDP = IC 09980000 IC = IC + 2000 09990000 OFFSET = IC 10000000 IC = IC + 1000 10010000 C 10020000 C RESERVE THE SPACE 10030000 C 10040000 NOWDS = IC - KPIUSM 10050000 CALL UPRESM (NOWDS) 10060000 IF (NOWDS .EQ. 0) GO TO 1910 10070000 C 10080000 C ==================================================================== 10090000 C RESERVE MEMORY FOR LIST OF OUTPUT VOLUMES 10100000 C ==================================================================== 10110000 C 10120000 KPVOLS = KPIUSM 10130000 IF ((KPVOLS/2) * 2 .EQ. KPVOLS) KPVOLS = KPVOLS + 1 10140000 IC = KPVOLS + 512 10150000 KPDSNS = IC 10160000 IC = IC + 4 10170000 NOWDS = IC - KPIUSM 10180000 CALL UPRESM (NOWDS) 10190000 IF (NOWDS .EQ. 0) GO TO 1910 10200000 COM(KPDSNS) = 0 10210000 COM(KPDSNS+1) = 0 10220000 C 10230000 C ==================================================================== 10240000 C ALLOCATE THE PLOT DATASET 10250000 C ==================================================================== 10260000 C 10270000 CALL UPNPLT (100, 1, 1, 1, TMPDSN, DDNMO, DYNAMF, ERR, ERIN) 10280000 IF (ERR .NE. 1) GO TO 1994 10290000 WRITE (KPPRNT, 8000) TMPDSN 10300000 CALL S1MVCH (TMPDSN,1,DSNAME,1,44) 10310000 C 10320000 C ================================================================= 10330000 C ALLOCATE THE WORK FILE 10340000 C ================================================================= 10350000 C 10360000 IF ( STACK.NE.0) NOREC = NOPT 10370000 IF (STACK.EQ.0 .AND. FLGATH.EQ.1) NOREC = NOPT*LCTPSP 10380000 IF (STACK.EQ.0 .AND. FLGATH.EQ.0) NOREC = NOPT*LCMXFD 10390000 C 10400000 IBYTES = 4 * TRCLEN 10410000 CALL UPAWRK(NOREC,IBYTES,'A',KPWRKS,KPWRKD,DDNAME,IERR,IERN) 10420000 IF (IERR .NE. 1) GO TO 1992 10430000 WRKALO = 1 10440000 C 10450000 CALL FOISSD (KPWRKS,IBYTES, 0) 10460000 DAWRK = 1 10470000 CALL ARSET (XCOM(KPIUSM),TRCLEN,0.0) 10480000 DO 92 I = 1,NOREC 10490000 92 CALL FOWSSD (KPWRKS,DAWRK,XCOM(KPIUSM)) 10500000 CALL FOCSD (KPWRKS) 10510000 CALL FOIDSD (KPWRKD,IBYTES) 10520000 C 10530000 C ================================================================= 10540000 C INITIALIZE 10550000 C ================================================================= 10560000 C 10570000 SHOT1 = -999999999 10580000 SHOT2 = -999999999 10590000 LSHOT = -999999999 10600000 IR = 0 10610000 FLAN = 0 10620000 NOWIN = 0 10630000 SPDPCT = 0 10640000 DAWRK = 1 10650000 CORMSG = 0 10660000 NS = 0 10670000 TNS = 0 10680000 C 10690000 GO TO 110 10700000 C 10710000 C ==================================================================== 10720000 C MAIN PROCESSING ENTRY 10730000 C ==================================================================== 10740000 C 10750000 100 CALL ARMVE (COM(KPIRSM),DLOCAL,LLOCAL) 10760000 C 10770000 C IF ANTYPE=1 STILL IN PROGRESS, KEEP GOING 10780000 C 10790000 IF (KPMOTF.EQ.1 ) GO TO 400 10800000 IF (KPMITF.NE.0 ) GO TO 110 10810000 C 10820000 IF (FLAN.LE.0 ) GO TO 875 10830000 IF (FLAN.GT.0 .AND. SPDPCT.GE.SDPCNT) GO TO 300 10840000 GO TO 850 10850000 C 10860000 110 CALL ARMVE (INH, OH, TRCLEN) 10870000 C 10880000 C IF THE INPUT IS NOT A LIVE TRACE THEN PASS IT OUT 10890000 C 10900000 CALL USRTHV( OH,'THTICD ',TICD) 10910000 IF (TICD .NE. 1) GO TO 1000 10920000 C 10930000 120 CONTINUE 10940000 C 10950000 C CHECK TO SEE IF THE SP/DP HAS CHANGED 10960000 C 10970000 IF (FLGATH .EQ. 0) CALL USRTHV( OH,'THCDPN ',TSHOT) 10980000 IF (FLGATH .EQ. 0) CALL USRTHV( OH,'THCDPT ',TRC ) 10990000 IF (FLGATH .EQ. 1) CALL USRTHV( OH,'THSSP ',TSHOT) 11000000 IF (FLGATH .EQ. 1) CALL USRTHV( OH,'THORTN ',TRC ) 11010000 C 11020000 IF (KPBUGF.GE.1) WRITE(KPPRNT,2323) 11030000 * TSHOT,TRC,SHOT1,SHOT2,SPDPCT,SDPCNT, 11040000 * FLAN,DAWRK,NOWIN,LSHOT,IR,LFOUR,WINMXL 11050000 2323 FORMAT( '0 TSHOT TRC SHOT1 SHOT2 SPDPCT SDPCNT ', 11060000 * 'FLAN DAWRK NOWIN LSHOT IR LFOUR WINMXL',/, 11070000 * 2X,I5,I4,I6,I6,I7,I7,I5,I6,I6,I6,I4,I6,I7) 11080000 C 11090000 C CHECK FOR A NEW RANGE 11100000 C 11110000 IF ( SHOT1.LE.TSHOT .AND. TSHOT.LE.SHOT2 ) GO TO 125 11120000 IF ( SHOT2.LE.TSHOT .AND. TSHOT.LE.SHOT1 ) GO TO 125 11130000 IF ( FLAN .LE.0 ) GO TO 135 11140000 IF ( SPDPCT.GE.SDPCNT ) GO TO 280 11150000 GO TO 1830 11160000 C 11170000 C SAME RANGE; NEW TRACE 11180000 C 11190000 125 CONTINUE 11200000 IF ( TSHOT .EQ. LSHOT ) GO TO 180 11210000 IF ( SPDPCT.GE.SDPCNT ) GO TO 280 11220000 GO TO 180 11230000 C 11240000 135 K = DAT 11250000 C 11260000 DO 140 I=SRANGE, ERANGE, 2 11270000 IF ( (COM(I) .LE. TSHOT) .AND. 11280000 * (COM(I+1) .GE. TSHOT) ) 11290000 * GO TO 150 11300000 K=K+2 11310000 140 CONTINUE 11320000 C 11330000 GO TO 900 11340000 C 11350000 C CURRENT SHOT IN A RANGE; GET PARMS FOR IT 11360000 C 11370000 150 CONTINUE 11380000 C 11390000 C 11400000 DAP = COM(K) 11410000 CALL FORP (KPNA,KPRNO,DAP,104,DENTRY, * 1930) 11420000 CALL ARMVE (DATTR,DLOCAL,NOPAR) 11430000 IF ( (COM(I) .NE. SPT) .OR. 11440000 * (COM(I+1) .NE. EPT)) GO TO 1920 11450000 C 11460000 SHOT1 = SPT 11470000 SHOT2 = EPT 11480000 C 11490000 C SET UP VALUES WHICH MAY CHANGE WITH NEW PARAMETER CARDS 11500000 C REENTRY TO SDCORA IS AT LABEL 100 11510000 C 11520000 DIST = FLOAT(INTTOL) / 100. * GRPINT 11530000 C 11540000 IF ( STACK .NE. 0) THEN 11550000 SDPCNT = IABS(EPT-SPT) + 1 11560000 OFFMIN = 0 11570000 OFFMAX = SDPCNT * GRPINT 11580000 END IF 11590000 C 11600000 XCOM(OFFSET+0)= OFFMIN 11610000 C 11620000 DO 155 I8 = 2, NROFF 11630000 XCOM(OFFSET+I8-1) = XCOM(OFFSET+I8-2) + GRPINT 11640000 IF (XCOM(OFFSET+I8-1) .LE. FLOAT(OFFMAX)) GO TO 155 11650000 NOFF = I8 - 1 11660000 GO TO 160 11670000 155 CONTINUE 11680000 NOFF = NROFF 11690000 160 CONTINUE 11700000 C 11710000 CALL S1MVCH(TYPPNT,1,PRMODE,1,8) 11720000 WRITE(KPPRNT,9020) PRMODE 11730000 C 11740000 C =============================================================== 11750000 C TRACE WINDOW LOADING CODE 11760000 C =============================================================== 11770000 C 11780000 180 FLAN = 1 11790000 C 11800000 IF(TSHOT.NE.LSHOT) THEN 11810000 SPDPCT = SPDPCT+1 11820000 C 11830000 IF (NS.EQ.24) THEN 11840000 WRITE(KPPRNT, 9030) TNS, PSHOT 11850000 NS = 0 11860000 ENDIF 11870000 C 11880000 NS = NS + 1 11890000 TNS=TNS + 1 11900000 PSHOT(NS) = TSHOT 11910000 ENDIF 11920000 C 11930000 LSHOT = TSHOT 11940000 C 11950000 C CHECK THE OFFSET AND SEE IF WE'RE IN RANGE 11960000 C 11970000 CALL USRTHV( OH,'THXDST ',OFFTEM) 11980000 C 11990000 IF (STACK .EQ. 0) GO TO 201 12000000 OFFTEM = 0 12010000 GO TO 203 12020000 C 12030000 201 CONTINUE 12040000 DO 202 JOFF = 1, NOFF 12050000 IOFF = JOFF 12060000 LDIST = XCOM(OFFSET+IOFF-1) - DIST 12070000 RDIST = XCOM(OFFSET+IOFF-1) + DIST 12080000 IF ( OFFTEM .LT. LDIST .OR. OFFTEM .GT. RDIST) GO TO 202 12090000 GO TO 203 12100000 202 CONTINUE 12110000 C 12120000 CX WRITE(KPPRNT, 9240) OFFTEM 12130000 GO TO 900 12140000 C 12150000 203 CONTINUE 12160000 C 12170000 C DON'T EXCEED THE RESERVED AREA IN BLANK COMMON 12180000 C 12190000 IF ( NOWIN .LT. NRWIN ) GO TO 210 12200000 WRITE (KPPRNT, 9980) 12210000 GO TO 280 12220000 C 12230000 210 NOWIN = NOWIN + 1 12240000 C 12250000 C STORE OFFSET BIN VALUE IN WHICH THE TRACE HEADER FALLS 12260000 C IF WE HAVE STACKED DATA SET UP ARTIFICIAL TRACE DISTANCES 12270000 C BETWEEN CONSECUTIVE CDP (NOT NECESSARY) 12280000 C 12290000 COM(WINOFF+NOWIN-1) = XCOM(OFFSET+IOFF-1) 12300000 IF (STACK .NE. 0) COM(WINOFF+NOWIN-1) = NOWIN * GRPINT 12310000 C 12320000 COM(WINPNT+NOWIN-1) = DAWRK 12330000 COM(WINSDP+NOWIN-1) = TSHOT 12340000 C 12350000 IF ( NOWIN .EQ. 2 ) CALL ARMVE ( OH, COM(PHEADR), THL) 12360000 CALL USRTHV ( OH, 'THNMF ',NMF) 12370000 C 12380000 IF (STACK .GT. 0) THEN 12390000 STIME = NSTIME 12400000 ETIME = NETIME 12410000 GO TO 240 12420000 ENDIF 12430000 C 12440000 C WINDOW ADJUSTMENT FOR NMO 12450000 C 12460000 C IF SNMOV = 0, NMF = 0 ; ATTEMPTING TO USE NO NMO ON SHOT 12470000 C OR CDP GATHERS. IF SNMOV NE 0, NMF NE 0 ; ATTEMPTING TO 12480000 C APPLY NMO TO DATA WHICH HAS ALREADY BEEN MOVED OUT. 12490000 C 12500000 IF((SNMOV .EQ. 0 .AND. NMF .EQ. 0) .OR. 12510000 + (SNMOV .NE. 0 .AND. NMF .NE. 0)) THEN 12520000 C 12530000 WRITE (KPPRNT,9100) SNMOV,NMF 12540000 KPRTF = -1 12550000 GO TO 900 12560000 C 12570000 ELSE IF (SNMOV .EQ. 0 .AND. NMF .NE. 0) THEN 12580000 STIME = NSTIME 12590000 GO TO 230 12600000 C 12610000 ELSE IF (SNMOV .NE. 0 .AND. NMF .EQ. 0) THEN 12620000 STIME = INT( SQRT (FLOAT( NSTIME*NSTIME ) 12630000 * +1000000.0*FLOAT( OFFTEM*OFFTEM )/ FLOAT(SNMOV*SNMOV))) 12640000 C 12650000 ENDIF 12660000 C 12670000 230 CONTINUE 12680000 C 12690000 C IF ENMOV = 0, NMF = 0 ; ATTEMPTING TO USE NO NMO ON SHOT 12700000 C OR CDP GATHERS. IF ENMOV NE 0, NMF NE 0 ; ATTEMPTING TO 12710000 C APPLY NMO TO DATA WHICH HAS ALREADY BEEN MOVED OUT. 12720000 C 12730000 IF((ENMOV .EQ. 0 .AND. NMF .EQ. 0) .OR. 12740000 + (ENMOV .NE. 0 .AND. NMF .NE. 0)) THEN 12750000 C 12760000 WRITE (KPPRNT,9110) ENMOV,NMF 12770000 KPRTF = -1 12780000 GO TO 900 12790000 C 12800000 ELSE IF (ENMOV .EQ. 0 .AND. NMF .NE. 0) THEN 12810000 ETIME = NETIME 12820000 GO TO 240 12830000 C 12840000 ELSE IF (ENMOV .NE. 0 .AND. NMF .EQ. 0) THEN 12850000 ETIME = INT( SQRT (FLOAT( NETIME*NETIME ) 12860000 * +1000000.0*FLOAT( OFFTEM*OFFTEM )/ FLOAT(ENMOV*ENMOV))) 12870000 C 12880000 ENDIF 12890000 C 12900000 C 12910000 240 CONTINUE 12920000 C 12930000 IF (STIME.LT.0) STIME=0 12940000 IF (ETIME.GT.LCRL) ETIME=LCRL 12950000 COM(WINLEN+NOWIN-1) = (ETIME - STIME)/SAMINT + 1 12960000 IF (COM(WINLEN+NOWIN-1).GT.NOSAMP) 12970000 * COM(WINLEN+NOWIN-1) = NOSAMP 12980000 C 12990000 C IF ( WINLEN(NOWIN) .LE. LWIN ) GO TO 250 13000000 C WRITE ( KPPRNT, 9810 ) WINLEN(NOWIN),LWIN 13010000 C WINLEN(NOWIN) = LWIN 13020000 C 13030000 250 CONTINUE 13040000 C 13050000 C LOAD THE WINDOW ONTO DISK 13060000 C 13070000 TPN = STIME/SAMINT + 1 13080000 CALL ARSET ( XCOM(KPIUSM), NOSAMP, 0.0) 13090000 CALL ARMVE ( OTR(TPN), XCOM(KPIUSM), COM(WINLEN+NOWIN-1) ) 13100000 CALL FOWDSD (KPWRKD,DAWRK,XCOM(KPIUSM)) 13110000 C 13120000 KPRTF = 1 13130000 IF (IABS(ANTYPE).EQ.1) KPRTF = 0 13140000 GO TO 900 13150000 C 13160000 C =================================================================== 13170000 C GROUP PROCESSING INITIALIZATION 13180000 C =================================================================== 13190000 C 13200000 280 CALL ARMVE ( OH,COM(TRCSAV),TRCLEN) 13210000 C 13220000 300 FLAN = 0 13230000 C 13240000 C SET THE NUMBER OF TRACES TO BE ANALYZED 13250000 C 13260000 TRCCNT = NOWIN 13270000 IF ( TRCCNT .GT. 1 ) GO TO 320 13280000 WRITE (KPPRNT, 9970) 13290000 GO TO 850 13300000 C 13310000 320 IR = 0 13320000 CALL USSRTC (TRCCNT,1,'INCR',1, 13330000 * COM(WINOFF),COM(WINLEN),COM(WINPNT),COM(WINSDP)) 13340000 C 13350000 350 CONTINUE 13360000 C 13370000 WRITE(KPPRNT, 9030) TNS,(PSHOT(I),I=1,NS) 13380000 WRITE(KPPRNT, 9040) 13390000 NS = 0 13400000 C 13410000 IF (IABS(ANTYPE) .NE. 1) GO TO 500 13420000 C 13430000 C ==================================================================== 13440000 C ANTYPE = 1 (TRACE OUTPUT) 13450000 C ==================================================================== 13460000 C 13470000 400 CONTINUE 13480000 C 13490000 IR = IR + 1 13500000 IF (IR.GE.TRCCNT .AND. ANTYPE.EQ.-1) GO TO 850 13510000 IF (IR.GT.TRCCNT .AND. ANTYPE.EQ. 1) GO TO 850 13520000 C 13530000 KPRTF = 1 13540000 C 13550000 CALL ARMVE (COM(PHEADR),OH,THL) 13560000 CXOUT CALL USSTHV (OH,'THCDPT ',IR) 13570000 CALL ARSET (OTR,NOSAMP,0.) 13580000 C 13590000 LTEMP1 = KPIUSM 13600000 LTEMP2 = LTEMP1+NOSAMP 13610000 CORBUF = LTEMP2+NOSAMP 13620000 IF (CORBUF+2*NOSAMP.GT.KPIUSM+KPNUSM) GO TO 1910 13630000 C 13640000 WINLN1 = COM(WINLEN+IR-1) 13650000 DAWRK1 = COM(WINPNT+IR-1) 13660000 CALL FORDSD (KPWRKD,DAWRK1,XCOM(LTEMP1)) 13670000 C 13680000 C SET UP TO CALL THE CORRELATION ROUTINE 13690000 C 13700000 IF (ANTYPE .EQ. 1) THEN 13710000 C 13720000 CC CALL ARCORR (XCOM(LTEMP1),WINLN1,XCOM(LTEMP1),WINLN1, 13730000 CC * XCOM(CORBUF)) 13740000 LCORR = 2*WINLN1-1 13750000 IF(LCORR.GT.NOSAMP) LCORR=NOSAMP 13760000 WVST = -(WINLN1-1)*SAMINT 13770000 WVET = WVST+(LCORR-1)*SAMINT 13780000 CALL ARMVE (XCOM(CORBUF),OTR,LCORR ) 13790000 CALL USSTHV (OH,'THWGID ',IR) 13800000 CALL USSTHV (OH,'THWVST ',WVST) 13810000 CALL USSTHV (OH,'THWVET ',WVET) 13820000 CALL USSTHV (OH,'THWVRT ',WVST) 13830000 C 13840000 C CHECK FOR LAST TRACE AND CROSS-CORRELATE 13850000 C 13860000 ELSE IF (ANTYPE .EQ. -1 ) THEN 13870000 C 13880000 WINLN2 = COM(WINLEN+IR-0) 13890000 DAWRK2 = COM(WINPNT+IR-0) 13900000 CALL FORDSD (KPWRKD,DAWRK2,XCOM(LTEMP2)) 13910000 C 13920000 CC CALL ARCORR (XCOM(LTEMP1),WINLN1,XCOM(LTEMP2),WINLN2, 13930000 CC * XCOM(CORBUF)) 13940000 LCORR = WINLN1+WINLN2-1 13950000 IF(LCORR.GT.NOSAMP) LCORR=NOSAMP 13960000 WVST = -(WINLN2-1)*SAMINT 13970000 WVET = WVST+(LCORR-1)*SAMINT 13980000 CALL ARMVE (XCOM(CORBUF),OTR,LCORR ) 13990000 CALL USSTHV (OH,'THWGID ',IR) 14000000 CALL USSTHV (OH,'THWVST ',WVST) 14010000 CALL USSTHV (OH,'THWVET ',WVET) 14020000 CALL USSTHV (OH,'THWVRT ',WVST) 14030000 C 14040000 END IF 14050000 C 14060000 IF (LCORR.GT.NOSAMP) GO TO 1950 14070000 C 14080000 450 KPMOTF = 1 14090000 GO TO 900 14100000 C 14110000 C ==================================================================== 14120000 C FIND LIMITS ON CURRENT DATASET PARAMETERS 14130000 C ==================================================================== 14140000 C 14150000 500 CONTINUE 14160000 C 14170000 MAXSDP = COM(WINSDP) 14180000 MINSDP = MAXSDP 14190000 WINMXL = COM(WINLEN) 14200000 WINMNL = WINMXL 14210000 C 14220000 DO 501 J8=2,TRCCNT 14230000 MAXSDP = MAX0( MAXSDP, COM(WINSDP+J8-1)) 14240000 MINSDP = MIN0( MINSDP, COM(WINSDP+J8-1)) 14250000 WINMXL = MAX0( WINMXL, COM(WINLEN+J8-1)) 14260000 WINMNL = MIN0( WINMNL, COM(WINLEN+J8-1)) 14270000 501 CONTINUE 14280000 C 14290000 C 14300000 C FIND THE LENGTH OF THE FFT 14310000 C 14320000 TEMPO =2*WINMXL 14330000 CALL S1FMAG ( TEMPO,MAG,LFOUR ) 14340000 LFOURH = LFOUR/2 14350000 NFTPTS = LFOURH + 1 14360000 LFOUR2 = LFOUR+2 14370000 NFREQ = LFOUR2 14380000 AMPREC = SQRT(0.5*FLOAT(LFOUR)) 14390000 C 14400000 C SET THE NUMBER OF LAGS TO TRANSFORM ( MAXCLN ) 14410000 C AND SET THE DEFAULTS IF NECESSARY 14420000 C 14430000 TEMPO = INT ( FLOAT( MAXLAG )/FLOAT( SAMINT ) ) 14440000 MAXCLN = INT ( FLOAT( NETIME-NSTIME )/FLOAT( SAMINT ) ) 14450000 IF ( TEMPO .LE. 0 ) TEMPO = MAXCLN 14460000 MAXCLN = TEMPO 14470000 C 14480000 C SET UP MAXIMUM WINDOW LENGTH FOR CROSS CORRELATION TO 14490000 C HAVE NO MORE THAN WINMNL SAMPLES. 14500000 C 14510000 IF ( MAXCLN .GT. WINMNL ) MAXCLN = WINMNL 14520000 CCCCC IF ( MAXCLN .GT. (LWIN-1) ) MAXCLN = LWIN-1 14530000 C 14540000 C ==================================================================== 14550000 C SET UP WORK AREAS IN UNRESERVED COMMON 14560000 C ==================================================================== 14570000 C 14580000 EXPWIN = KPIUSM 14590000 CORBUF = EXPWIN + LFOUR2 14600000 CORSCL = CORBUF + LFOUR2 14610000 CRANV = CORSCL + 2000 14620000 CORRX1 = CRANV + LFOUR2 14630000 CRANV2 = CORRX1 + LFOUR2 14640000 CORRX2 = CRANV2 + LFOUR2 14650000 CORTEM = CORRX2 + LFOUR2 14660000 CRANUT = CORTEM + LFOUR2 14670000 FFTEM = CRANUT + LFOUR2 14680000 FFT1 = FFTEM + LFOUR2 14690000 FFT2 = FFT1 + LFOUR2 14700000 FFT3 = FFT2 + LFOUR2 14710000 FFT4 = FFT3 + LFOUR2 14720000 FFT5 = FFT4 + LFOUR2 14730000 FFT6 = FFT5 + LFOUR2 14740000 PLTBUF = FFT6 + LFOUR2 14750000 LTEMP1 = PLTBUF + LFOUR2 14760000 LTEMP2 = LTEMP1 + MAX0(TRCLEN,LFOUR2) 14770000 XALGN = LTEMP2 + MAX0(TRCLEN,LFOUR2) 14780000 AVC0 = XALGN + LFOUR2 14790000 AVC1 = AVC0 + LFOUR2 14800000 AVC2 = AVC1 + LFOUR2 14810000 AVC3 = AVC2 + LFOUR2 14820000 RAT0 = AVC3 + LFOUR2 14830000 RAT1 = RAT0 + LFOUR2 14840000 SCR1 = RAT1 + LFOUR2 14850000 SCR2 = SCR1 + LFOUR2 14860000 SCRTCH = SCR2 + LFOUR2 14870000 C 14880000 IF (SCRTCH+2000.GE.KPIUSM+KPNUSM) GO TO 1910 14890000 C 14900000 C ==================================================================== 14910000 C OPEN THE PLOTFILE 14920000 C ==================================================================== 14930000 C 14940000 IF (OPNFLG .NE. 0) GO TO 502 14950000 C 14960000 C INITIALIZE PLOT PACKAGE 14970000 C 14980000 IPLTNO = IPLTNO + 1 14990000 NRES = 200 15000000 PLTWDS = KPIUSM+KPNUSM-SCRTCH 15010000 XFACT = 0.005*FLOAT(ISHORT) 15020000 C 15030000 COUT CALL DEVMOD(NRES,MSCWID) 15040000 C 11" : MSCWID=2112DPS=10.56IN 15050000 C 22" : MSCWID=4224DPS=21.12IN 15060000 C 36" : MSCWID=7040DPS=35.20IN 15070000 C 42" : MSCWID=8096DPS=40.48IN 15080000 C 15090000 YWIDTH = 38.00 15100000 IF(ISHORT.LE.250) YWIDTH = 34.00 15110000 IF(ISHORT.LE.150) YWIDTH = 20.00 15120000 IF(ISHORT.LE. 80) YWIDTH = 9.50 15130000 C 15140000 GRID = .FALSE. 15150000 IF (GRIDSW.NE.0) GRID = .TRUE. 15160000 C 15170000 COM(SCRTCH) = 1 15180000 CALL PLOTS (XCOM(SCRTCH),-PLTWDS,0.,YWIDTH,IPLTNO,KPDBGS,0) 15190000 CALL FACTOR(XFACT) 15200000 C 15210000 OPNFLG = 1 15220000 C 15230000 C RESET ORIGIN FOR PLOTS 15240000 C 15250000 CALL SACOR1 ( XCOM(FFT1 ), XCOM(PLTBUF),-1, PNUMP(1), 15260000 * LABELX , LABELY , 2, AAXIS(1), LABELL , 15270000 * LABELT , 0, ITYPE(1), NFREQ, GRID, 15280000 * XCOM(SCR1), XCOM(SCR2) ) 15290000 C 15300000 502 CONTINUE 15310000 C 15320000 C PLOT LOGO 15330000 C 15340000 CALL SALOGO 15350000 C 15360000 CALL SYMBOL (-.5, 2.5, 0.21, 'ARCO EXPLORATION', 90.0, 16) 15370000 CALL SYMBOL (0.0, 2.5, 0.14, 15380000 * 'EXPLORATION DATA PROCESSING ', 90.0, 28) 15390000 CALL SYMBOL ( .3, 2.5, 0.14, 15400000 * 'SPARC SEISMIC PROCESSING SYSTEM', 90.0, 31)15410000 CALL SYMBOL ( .6, 2.5, 0.14, 'MULTI-TRACE SPECTRAL ANALYSIS', 15420000 * 90.0, 29) 15430000 CALL PLOT (2.0, 0.0, -3) 15440000 C 15450000 C PLOT THE LABEL 15460000 C 15470000 CALL DATIME (DATE, TIME, TDUMM) 15480000 FPSPT = MINSDP 15490000 FPEPT = MAXSDP 15500000 C 15510000 CALL SYMBOL(0.0, 0.0,0.14,'DATE : ', 90.0, 8)15520000 CALL SYMBOL(0.0 ,1.28,0.14, DATE, 90.0, 8)15530000 CALL SYMBOL(0.5, 0.0,0.14,'ANALYST : ', 90.0,11)15540000 CALL SYMBOL(0.5 ,1.28,0.14,ACUSER, 90.0,20)15550000 CALL SYMBOL(1.0, 0.0,0.14,'DSNAME : ', 90.0,11)15560000 CALL SYMBOL(1.0 ,1.28,0.14,DSNAME, 90.0,44)15570000 IF (FLGATH .EQ. 0 ) CALL SYMBOL( 1.5,0.0 ,0.14, 'DP ',90.0, 4)15580000 IF (FLGATH .EQ. 1 ) CALL SYMBOL( 1.5,0.0 ,0.14, 'SP ',90.0, 4)15590000 CALL NUMBER( 1.5, .71,0.14,FPSPT, 90.0,-1)15600000 CALL SYMBOL( 1.5,1.43,0.14,' TO ', 90.0, 6)15610000 CALL NUMBER( 1.5,2.43,0.14,FPEPT, 90.0,-1)15620000 C 15630000 CALL PLOT (3.5+2.0*FLOAT(PROCFL), 0.0,-3) 15640000 C 15650000 C WRITE OUT USER COMMENTS FOR THIS PROCESS 15660000 C IF PROCESS FLAG IS ZERO (PROCFL). THAT IS, THE 15670000 C PROCESS HAS BEEN ENTERED OR REENTERED SEQUENTIALLY 15680000 C 15690000 IF (PROCFL .NE. 0) GO TO 503 15700000 C 15710000 C FIRST ENCLOSE COMMENTS IN BOX 15720000 C 15730000 CALL PLOT ( 0.0,10.28,2 ) 15740000 CALL PLOT ( 2.0,10.28,2 ) 15750000 CALL PLOT ( 2.0, 0.0 ,2 ) 15760000 CALL PLOT ( 0.0, 0.0 ,2 ) 15770000 C 15780000 C WRITE USER COMMENT UP TO THREE RECORDS 15790000 C 15800000 CALL SYMBOL( .5,0.25,.14,'REMARK:',90.0,7) 15810000 CALL SYMBOL( .5,1.39,.14,REMARK(1,1),90.,60) 15820000 CALL SYMBOL( 1.0,1.39,.14,REMARK(1,2),90.,60) 15830000 CALL SYMBOL( 1.5,1.39,.14,REMARK(1,3),90.,60) 15840000 C 15850000 C RESET ORIGIN FOR PLOTS 15860000 C 15870000 CALL PLOT (5.0,0.0,-3) 15880000 C 15890000 C SET PROCESS FLAG NON-ZERO TO AVOID REPRINTING REMARK 15900000 C 15910000 PROCFL = 1 15920000 C 15930000 503 CONTINUE 15940000 C 15950000 C WRITE HEADING ON OUTPUT TO IDENTIFY ANALYSIS 15960000 C 15970000 CALL S1MVCH (TYPPNT,1,PRMODE,1,8) 15980000 C WRITE (KPPRNT,9120)PRMODE,MINSDP,MAXSDP 15990000 C 16000000 C ===================================================================== 16010000 C SMOOTHING OPTIONS 16020000 C ===================================================================== 16030000 C 16040000 CALL ARSET ( XCOM(EXPWIN), LFOUR, 0.0 ) 16050000 MAXCL2 = MAXCLN-1 16060000 C 16070000 GO TO (521, 525, 535 ), SMOOTH 16080000 C 16090000 521 TEMPOR = PI/FLOAT(MAXCL2) 16100000 DO 522 J8=1,MAXCLN 16110000 XCOM(EXPWIN+J8-1) = 0.54+0.46*COS(FLOAT((J8-1))*TEMPOR) 16120000 522 CONTINUE 16130000 DO 523 J8=1,MAXCL2 16140000 XCOM(EXPWIN+LFOUR-J8) = XCOM(EXPWIN+J8) 16150000 523 CONTINUE 16160000 NRAT = SQRT( 2.0*FLOAT(LFOUR )/FLOAT(MAXCLN*2) ) 16170000 GO TO 540 16180000 C 16190000 C 16200000 525 CONTINUE 16210000 TEMPOR = FLOAT( MAXCLN - 1 ) 16220000 NRAT = SQRT( (4*0.89/PI)*FLOAT(LFOUR )/FLOAT(MAXCLN*2) ) 16230000 C 16240000 C THE ORIGINAL VERSION HAD THE GAUSSIAN WEIGHTING SUCH THAT 16250000 C AT HALF THE NUMBER OF LAGS IN THE CORRELATION WINDOW, ITS 16260000 C WEIGHT WAS DOWN TO 1/E AND AT MAXCLN IT WAS DOWN TO 16270000 C E**(-4). THIS HAS BEEN CHANGED SO THAT AT THE WINDOW 16280000 C LENGTH, MAXCLN, THE WEIGHT IS 1/(E**2). THE ORIGINAL METHOD 16290000 C EFFECTIVELY CUT THE WINDOWING TO HALF THAT DESIRED. 16300000 C 16310000 DO 532 J8=1,MAXCLN 16320000 TEMPR1 = FLOAT( J8 - 1 )/TEMPOR 16330000 XCOM(EXPWIN+J8-1) = EXP(-2.0*TEMPR1*TEMPR1) 16340000 532 CONTINUE 16350000 DO 533 J8=1,MAXCL2 16360000 XCOM(EXPWIN+LFOUR-J8) = XCOM(EXPWIN+J8) 16370000 533 CONTINUE 16380000 GO TO 540 16390000 C 16400000 535 CONTINUE 16410000 TEMPOR = 1.00 16420000 CALL ARSET ( XCOM(EXPWIN ), MAXCLN, TEMPOR ) 16430000 CALL ARSET ( XCOM(EXPWIN+LFOUR-MAXCLN ), MAXCLN, TEMPOR ) 16440000 NRAT = SQRT( FLOAT(LFOUR )/FLOAT(MAXCLN*2) ) 16450000 C 16460000 C 16470000 540 CONTINUE 16480000 C 16490000 C 16500000 C SET UP THE ALIGNMENT PARAMETERS 16510000 C ALGNCT IS NUMBER OF AUTO-CORR LAGS TO INCLUDE 16520000 C IN CROSS-CORR ALIGNMENT WITH AUTO-CORR. IT IS 16530000 C SET TO BE 15% OF ZERO LAG WINDOW LENGTH. 16540000 C 16550000 C 541 ALGNCT = INT( ALGNFC*FLOAT( (NETIME-NSTIME)/SAMINT ) ) 16560000 C SLIDCT = ALTIME / SAMINT 16570000 C IF (ALGNCT .LT. SLIDCT) ALGNCT = SLIDCT 16580000 C 16590000 541 ALGNCT = ALTIME / SAMINT 16600000 NYFREQ = 500/SAMINT 16610000 C 16620000 C RETRIEVE VALUE OF ISHORT FROM DENTRY TO SEE IF WE ARE 16630000 C TO PLOT WITH AXES SCALING SET UP BY PROGRAM IN AAXIS 16640000 C OR TO USE DEFAULTS IN SUBROUTINE LOGPLT. IF ISHORT = 0 16650000 C THEN SCALE SIZES ARE SET UP IN AAXIS. IF ISHORT NE 0 16660000 C THEN USE THE DEFAULT VALUE IN LOGPLT WHICH IS AN X-AXIS 16670000 C OF 15" AND Y-AXIS OF 9.5". 16680000 C 16690000 C 16700000 ITYPE(1) = 3 16710000 ITYPE(2) = 2 16720000 ITYPE(3) = 3 16730000 ITYPE(4) = 2 16740000 ITYPE(5) = 3 16750000 ITYPE(6) = 1 16760000 C 16770000 AAXIS(1) = 6 16780000 AAXIS(2) = 1.5 16790000 AAXIS(3) = 1.E-5 16800000 AAXIS(4) = 25.0*FLOAT(MAXFRQ)/FLOAT(NYFREQ) 16810000 AAXIS(5) = 0 16820000 AAXIS(6) = 0.04*FLOAT(NYFREQ) 16830000 C 16840000 C SET SEMI-LOG PLOT SELECTION TO EITHER DEFAULT SIZE OR THAT 16850000 C DESCRIBED BY ARRAY AAXIS. IPLT = 6 SCALE DEFINED ABOVE, 16860000 C IPLT = 2 THEN THE DEFAULT SIZE (15"X9.5"). IF ISHORT = 0 16870000 C THEN DO NOT USE THE DEFAULT VALUES. IF ISHORT NE 0 THEN 16880000 C USE THE DEFAULT PLOT SIZE. 16890000 C 16900000 CX IF (ISHORT .EQ. 0) THEN 16910000 IPLT = 6 16920000 CX ELSE 16930000 CX IPLT = 2 16940000 CX END IF 16950000 C 16960000 C DETERMINE THE NUMBER OF OFFSETS TO CROSS-CORRELATE 16970000 C THE MAXIMUM NUMBER OF OFFSET DIFFERENCES ALLOWED IN 16980000 C CROSS-CORRELATION IS NINE (9) TRACE-OFFSETS 16990000 C 17000000 MAXCRO = MXODIF 17010000 IF ( MAXCRO .GT. 9 ) MAXCRO = 9 17020000 IF ( MAXCRO .GT. (TRCCNT-1) ) MAXCRO = TRCCNT-1 17030000 C 17040000 C BUILD THE ARRAY WITH THE X-AXIS (FREQ) VALUES 17050000 C 17060000 DF = 1000./FLOAT(LFOUR*SAMINT) 17070000 C 17080000 DO 548 J8=1,NFTPTS 17090000 XCOM(PLTBUF+J8-1) = (J8-1)*DF 17100000 548 CONTINUE 17110000 C 17120000 C NFTCUT = FLOAT(MAXFRQ)/DF + 1.0 17130000 NFTCUT = INT((FLOAT(MAXFRQ) + 0.0001) / DF + 1.0 ) 17140000 IF (NFTCUT.GT.NFTPTS) NFTCUT=NFTPTS 17150000 C 17160000 DO 542 K8=1,11 17170000 PNUMP(K8) = NFTCUT 17180000 542 CONTINUE 17190000 C 17200000 C 17210000 C ==================================================================== 17220000 C FIND THE AVERAGE SPECTRUM AND THE 17230000 C STANDARD DEVIATION FOR ALL 17240000 C CORRELATION OFFSETS FROM ZERO 17250000 C (AUTO-CORR) THROUGH MAXCRO. 17260000 C ==================================================================== 17270000 C 17280000 C THE DESIGNER FOUND IT CONVENIENT TO BUILD A NON-DO LOOP SO IT COULD 17290000 C START WITH ZERO OFFSET. I7 IS THE ITERATION COUNTER. 17300000 C 17310000 C 17320000 ALNAV = 0 17330000 CORCNT = 0 17340000 TCOEFF = 0.0 17350000 TOTLOG = 0.0 17360000 I7 = 0 17370000 C 17380000 CALL ARSET ( XCOM(CRANUT),LFOUR2, 0.) 17390000 CALL ARSET ( XCOM(CORRX1),LFOUR2, 0.) 17400000 CALL ARSET ( XCOM(CORRX2),LFOUR2, 0.) 17410000 CXOUT CALL ARSET ( XCOM(FFTSUM),LFOUR2, 0.) 17420000 C 17430000 C =================================================================== 17440000 C BEGINNING OF LOOP FOR OFFSET GROUPS 17450000 C =================================================================== 17460000 C 17470000 550 IF ( I7 .GT. MAXCRO ) GO TO 700 17480000 C 17490000 C INITIALIZE STUFF FOR THE INNER LOOP *** 17500000 C 17510000 ALNOFF = ALNAV 17520000 ALNAV = 0 17530000 GRPCNT = 0 17540000 C 17550000 CALL ARSET ( XCOM(FFT1 ), LFOUR2, 0.) 17560000 CALL ARSET ( XCOM(FFT3 ), LFOUR2, 0.) 17570000 CALL ARSET ( XCOM(FFT5 ), LFOUR2, 0.) 17580000 C 17590000 C CROSS-CORRELATION REQUIRES BOTH 5TH AND 6TH COLS OF 17600000 C FFTBUF BECAUSE OF COMPLEX NATURE OF THE FFT. AFTER 17610000 C THE POWER IS COMPUTED IT IS STORED IN THE 5TH COL. 17620000 C 17630000 CALL ARSET ( XCOM(CRANV),LFOUR2,0.) 17640000 CALL ARSET ( XCOM(CRANV2),LFOUR2,0.) 17650000 C 17660000 XCOEFF = 0.0 17670000 C 17680000 C 17690000 C ************************************ 17700000 C * DO EACH CORRELATION IN A GIVEN * 17710000 C * TRACE OFFSET DIFFERENCE GROUP * 17720000 C ************************************ 17730000 C 17740000 C 17750000 DO 650 I8=1,TRCCNT 17760000 C 17770000 C SET UP FOR AND PERFORM THE FFT CORRELATIONS 17780000 C 17790000 J7 = I8 + I7 17800000 IF ( J7 .GT. TRCCNT ) GO TO 660 17810000 C 17820000 C RETRIEVE TRACE FROM DISK 17830000 C 17840000 DAWRK1 = COM(WINPNT+I8-1) 17850000 CALL FORDSD (KPWRKD,DAWRK1,XCOM(LTEMP1)) 17860000 C 17870000 DAWRK2 = COM(WINPNT+J7-1) 17880000 CALL FORDSD (KPWRKD,DAWRK2,XCOM(LTEMP2)) 17890000 C 17900000 CC IF (I7 .NE. 0) CORCNT = CORCNT+1 17910000 CC GRPCNT = GRPCNT + 1 17920000 C 17930000 WINLN1 = COM(WINLEN+I8-1) 17940000 WINLN2 = COM(WINLEN+J7-1) 17950000 C 17960000 IF (ITAPER.GT.0) THEN 17970000 TPRLN1 = WINLN1/ITAPER 17980000 ANG = PI/FLOAT(TPRLN1) 17990000 J=LTEMP1-1 18000000 K=WINLN1+LTEMP1 18010000 N=TPRLN1 18020000 DO555 I= 1,N 18030000 FRAC = 0.5*(1.0+COS(ANG*(N-I+1))) 18040000 XCOM(J+I) = FRAC*XCOM(J+I) 18050000 XCOM(K-I) = FRAC*XCOM(K-I) 18060000 555 CONTINUE 18070000 TPRLN2 = WINLN2/ITAPER 18080000 ANG = PI/FLOAT(TPRLN2) 18090000 J=LTEMP2-1 18100000 K=WINLN2+LTEMP2 18110000 N=TPRLN2 18120000 DO560 I= 1,N 18130000 FRAC = 0.5*(1.0+COS(ANG*(N-I+1))) 18140000 XCOM(J+I) = FRAC*XCOM(J+I) 18150000 XCOM(K-I) = FRAC*XCOM(K-I) 18160000 560 CONTINUE 18170000 ENDIF 18180000 C 18190000 MAXCLN = WINLN1+WINLN2-1 18200000 C 18210000 IF (KPBUGF.GE.2) WRITE(KPPRNT,6161) 18220000 * I7,I8,WINLN1,WINLN2 18230000 6161 FORMAT( '0 I7,I8,WINLN1,WINLN2 ',4I6 ) 18240000 C 18250000 CALL ARSET (XCOM(LTEMP1+WINLN1),LFOUR2-WINLN1,0.) 18260000 CALL ARSET (XCOM(LTEMP2+WINLN2),LFOUR2-WINLN2,0.) 18270000 C 18280000 CALL S2DFT2(MAG,XCOM(LTEMP1),*1820) 18290000 CALL S2DFT2(MAG,XCOM(LTEMP2),*1820) 18300000 C 18310000 DO 562 I = 1, LFOUR2, 2 18320000 XCOM(FFTEM+I-1) = XCOM(LTEMP1+I-1)*XCOM(LTEMP2+I-1) 18330000 * +XCOM(LTEMP1+I-0)*XCOM(LTEMP2+I-0) 18340000 XCOM(FFTEM+I-0) = XCOM(LTEMP1+I-0)*XCOM(LTEMP2+I-1) 18350000 * -XCOM(LTEMP1+I-1)*XCOM(LTEMP2+I-0) 18360000 562 CONTINUE 18370000 C 18380000 IF ( I7 .NE. 0 ) GO TO 575 18390000 C 18400000 C DO THE AUTO-CORRELATIONS 18410000 C 18420000 DO 563 I = 1, LFOUR2, 2 18430000 XCOM(CORBUF+I-1)= AMPREC*XCOM(FFTEM+I-1) 18440000 XCOM(CORBUF+I-0)= AMPREC*XCOM(FFTEM+I-0) 18450000 563 CONTINUE 18460000 C 18470000 CALL S2DFI2(MAG,XCOM(CORBUF),*1820) 18480000 C 18490000 XCOM(CORSCL+I8-1) = XCOM(CORBUF) 18500000 IF (XCOM(CORBUF).LE.0.0) GO TO 641 18510000 GRPCNT = GRPCNT + 1 18520000 C 18530000 IF(NORM .EQ. 0) THEN 18540000 CALL ARDVFC (XCOM(CORBUF),XCOM(CORBUF),XCOM(CORSCL+I8-1), 18550000 * LFOUR ) 18560000 ELSE 18570000 CFALOG = ALOG10(XCOM(CORBUF)/FLOAT(WINLN1)) 18580000 TOTLOG = TOTLOG+CFALOG 18590000 CALL ARDVFC (XCOM(CORBUF),XCOM(CORBUF),XCOM(CORSCL+I8-1), 18600000 * LFOUR ) 18610000 ENDIF 18620000 C 18630000 IF (KPBUGF.GE.3) 18640000 * WRITE(KPPRNT, 9705) I7,I8,XCOM(CORSCL+I8-1),XCOM(CORBUF) 18650000 9705 FORMAT(' I7,I8,CORSCL,CORBUF: ', 2I6,2E15.7) 18660000 C 18670000 DO 565 J8=1,LFOUR2 18680000 XCOM(CRANUT+J8-1)=XCOM(CRANUT+J8-1)+XCOM(FFTEM+J8-1) 18690000 565 CONTINUE 18700000 C 18710000 DO 570 I = 1,LFOUR 18720000 XCOM(FFTEM+I-1)=XCOM(CORBUF+I-1)*XCOM(EXPWIN+I-1) 18730000 570 CONTINUE 18740000 C 18750000 GO TO 630 18760000 C 18770000 575 CONTINUE 18780000 C 18790000 C ************************************** 18800000 C * CROSS-CORRELATION ALIGNMENT CODE * 18810000 C ************************************** 18820000 C 18830000 SCLFAC = SQRT (XCOM(CORSCL+I8-1)*XCOM(CORSCL+J7-1)) 18840000 IF (KPBUGF.GE.3) WRITE(KPPRNT, 9710) I7,I8,SCLFAC 18850000 9710 FORMAT(' I7,I8,SCLFAC: ', 2I6, E15.7) 18860000 C 18870000 IF (SCLFAC.EQ.0.0) GO TO 650 18880000 SCLCOR = SCLFAC 18890000 CX IF (NORM .EQ. 0) SCLFAC = 1.0 18900000 C 18910000 C INCREMENT THE COUNTERS FOR THIS OPPOSITE CROSS-CORRELATION 18920000 C 18930000 GRPCNT = GRPCNT + 2 18940000 CORCNT = CORCNT + 2 18950000 CORMAX = 0 18960000 IMX = 0 18970000 C 18980000 GO TO ( 580, 592, 600 ), ALTYPE 18990000 C 19000000 C 19010000 C ============================================= 19020000 C DETERMINE OPTIMAL SHIFT AND SUM FOR AVG 19030000 C ============================================= 19040000 C 19050000 580 CONTINUE 19060000 C 19070000 DO 590 I = 1, LFOUR2, 2 19080000 XCOM(XALGN+I-1) = XCOM(CRANUT+I-1)*XCOM(FFTEM +I-1) 19090000 * +XCOM(CRANUT+I-0)*XCOM(FFTEM +I-0) 19100000 XCOM(XALGN+I-0) = XCOM(CRANUT+I-0)*XCOM(FFTEM +I-1) 19110000 * -XCOM(CRANUT+I-1)*XCOM(FFTEM +I-0) 19120000 590 CONTINUE 19130000 C 19140000 GO TO 594 19150000 C 19160000 592 CONTINUE 19170000 C 19180000 DO 593 I = 1, LFOUR2, 2 19190000 XCOM(XALGN+I-1) = XCOM(FFTEM +I-1) 19200000 XCOM(XALGN+I-0) = -XCOM(FFTEM +I-0) 19210000 593 CONTINUE 19220000 C 19230000 594 CALL S2DFI2(MAG,XCOM(XALGN ),*1820) 19240000 C 19250000 XMX = XCOM(XALGN) 19260000 J=1 19270000 IMX=0 19280000 IMI=0 19290000 C 19300000 C SCAN FOR DIGITAL MAXIMUM 19310000 C 19320000 DO 595 I=1,ALGNCT 19330000 C 19340000 J=I+1 19350000 IF (XCOM(XALGN+J-1).GT.XMX) THEN 19360000 IMX = I 19370000 XMX = XCOM(XALGN+J-1) 19380000 ENDIF 19390000 J=LFOUR+1-I 19400000 IF (XCOM(XALGN+J-1).GT.XMX) THEN 19410000 IMX = -I 19420000 XMX = XCOM(XALGN+J-1) 19430000 ENDIF 19440000 C 19450000 595 CONTINUE 19460000 C 19470000 CXX IMI = IMX 19480000 CXX SMX = 0. 19490000 CXX SMF = 0. 19500000 CXX XMX = -999. 19510000 CXX IF (IABS(IMX).GE.ALGNCT-1) GO TO 619 19520000 IF (IABS(IMX).GE.ALGNCT-1) GO TO 615 19530000 C 19540000 C SMX IS INTERPOLATED LAG 19550000 600 SMX= IMX 19560000 IMI= IMX 19570000 SMF= 0.0 19580000 C 19590000 IF (ALTYPE.EQ.3) GO TO 615 19600000 C 19610000 C GET INDICES OF MAXIMA 19620000 K2 = 1+IMX 19630000 K1 = K2-1 19640000 K3 = K2+1 19650000 IF(K2.LE.0) K2=K2+LFOUR 19660000 IF(K1.LE.0) K1=K1+LFOUR 19670000 IF(K3.LE.0) K3=K3+LFOUR 19680000 C 19690000 C DIF = XCOM(XALGN-1+K1)+ 19700000 C * XCOM(XALGN-1+K3)-2.0*XCOM(XALGN-1+K2) 19710000 C IF(KPBUGF.GE.2) WRITE(KPPRNT, 9725) 19720000 C * XCOM(XALGN-1+K1), 19730000 C * XCOM(XALGN-1+K2), 19740000 C * XCOM(XALGN-1+K3),DIF 19750000 C9725 FORMAT(' XALGN INTERP: ',4E15.8) 19760000 C 19770000 SMX= SMX - 19780000 * 0.5*(XCOM(XALGN-1+K3)-XCOM(XALGN-1+K1))/ 19790000 * (XCOM(XALGN-1+K1)+ 19800000 * XCOM(XALGN-1+K3)-2.0*XCOM(XALGN-1+K2)) 19810000 C 19820000 IMI= NINT(SMX) 19830000 SMF= SMX-IMI 19840000 C 19850000 C XMX IS INTERPOLATED MAXIMUM 19860000 C XMX= 19870000 C * XCOM(XALGN-1+K2) - 19880000 C * (XCOM(XALGN-1+K3)-XCOM(XALGN-1+K1))* 19890000 C * (XCOM(XALGN-1+K3)-XCOM(XALGN-1+K1))/ 19900000 C * (8.0*(XCOM(XALGN-1+K1)+XCOM(XALGN-1+K3)- 19910000 C * 2.0* XCOM(XALGN-1+K2))) 19920000 C 19930000 IF (ABS(SMF).LT.0.01) GO TO 615 19940000 C 19950000 C APPLY FRACTIONAL PART OF SHIFT 19960000 C SHFT IS THE LINEAR PHASE SHIFT (IN RADIANS/DELTA F) 19970000 C CORRESPONDING TO THE TIME SHIFT SMF*LCPI MS 19980000 C 19990000 SHFT = -SMF*TWOPI/FLOAT(LFOUR) 20000000 C 20010000 DO 610 I = 1,LFOUR2,2 20020000 THETA = ((I-1)/2)*SHFT 20030000 CS = COS(THETA) 20040000 SS = SIN(THETA) 20050000 XCOM(CORBUF+I-1)= XCOM(FFTEM+I-1)*CS- 20060000 * XCOM(FFTEM+I-0)*SS 20070000 XCOM(CORBUF+I-0)= XCOM(FFTEM+I-0)*CS+ 20080000 * XCOM(FFTEM+I-1)*SS 20090000 610 CONTINUE 20100000 C 20110000 GO TO 618 20120000 C 20130000 C NO FRACTIONAL SHIFT SITUATION 20140000 C 20150000 615 CONTINUE 20160000 C 20170000 DO 616 I = 1,LFOUR2,2 20180000 XCOM(CORBUF+I-1)= XCOM(FFTEM+I-1) 20190000 XCOM(CORBUF+I-0)= XCOM(FFTEM+I-0) 20200000 616 CONTINUE 20210000 C 20220000 C RECOVER XCOR IMPULSE 20230000 618 CALL S2DFI2(MAG,XCOM(CORBUF),*1820) 20240000 C 20250000 IMX = IMI 20260000 SCL1 = AMPREC / SCLFAC 20270000 C 20280000 C POSITIVE LAG IMPLIES RAW XCORR EARLY 20290000 C NEGATIVE LAG IMPLIES RAW XCORR LATE 20300000 C 20310000 J=0 20320000 K=0-IMX 20330000 IF (K.LT.0) K=K+LFOUR 20340000 C 20350000 XMX = XCOM(CORBUF+K)*SCL1 20360000 C 20370000 619 CONTINUE 20380000 IF(KPBUGF.GE.2) WRITE(KPPRNT, 9715) I7,I8, 20390000 * SMX, IMI, SMF, XMX 20400000 9715 FORMAT(' I7,I8: ', 2I6, 20410000 * ' INT SAMPLE:',F7.2,' = ',I3,' + ',F6.3, 20420000 * ' INT MAXIMUM :',E12.5 ) 20430000 C 20440000 CXX IF (XMX.LT.XMCOR) THEN 20450000 CXX CORCNT = CORCNT-2 20460000 CXX GRPCNT = GRPCNT-2 20470000 CXX GO TO 650 20480000 CXX ENDIF 20490000 C 20500000 C NOW DO INTEGER PART OF SHIFT 20510000 C 20520000 DO 620 I = 1,LFOUR 20530000 C 20540000 J = J + 1 20550000 K = K + 1 20560000 IF (K.GT.LFOUR) K=K-LFOUR 20570000 XCOM(FFTEM+J-1) = XCOM(CORBUF+K-1)*SCL1 20580000 XCOM(CRANV+J-1) = XCOM(CRANV+J-1)+XCOM(CORBUF+K-1)*SCL1 20590000 C 20600000 620 CONTINUE 20610000 C 20620000 IF(KPBUGF.GE.2) WRITE(KPPRNT, 9718) CORCNT,GRPCNT, 20630000 * XCOM(FFTEM+LFOUR-2), 20640000 * XCOM(FFTEM+LFOUR-1), 20650000 * XCOM(FFTEM ), 20660000 * XCOM(FFTEM+1 ), 20670000 * XCOM(FFTEM+2 ) 20680000 9718 FORMAT(' CORCNT,GRPCNT: ', 2I6, 20690000 * ' XCOR CENTER: ',5E15.7 ) 20700000 C 20710000 XCOEFF = XCOEFF + 2.0*XMX 20720000 C 20730000 DO 625 I = 1,LFOUR 20740000 XCOM(FFTEM+I-1)=XCOM(FFTEM+I-1)*XCOM(EXPWIN+I-1) 20750000 625 CONTINUE 20760000 C 20770000 C SKIP FFT STUFF IF THE STANDARD DEVIATION 20780000 C ANALYSIS IS NOT WANTED FOR THE X-CORS 20790000 C 20800000 IF ( PLTYPE .EQ. 2 ) GO TO 650 20810000 C 20820000 630 CONTINUE 20830000 C 20840000 CALL S2DFT2 ( MAG, XCOM(FFTEM), * 1820) 20850000 C 20860000 IF ( I7 .NE. 0 ) GO TO 645 20870000 C 20880000 C SAVE POWER SPECTRUM AND SUM-OF-SQUARES FOR ACORS 20890000 C 20900000 LFOUR1 = LFOUR + 1 20910000 K8 = 0 20920000 C 20930000 DO 640 J8=1,LFOUR1,2 20940000 XCOM(FFT1+K8) = XCOM(FFT1+K8) + XCOM(FFTEM+J8-1) 20950000 XCOM(FFT3+K8) = XCOM(FFT3+K8) + 20960000 * XCOM(FFTEM+J8-1)*XCOM(FFTEM+J8-1) 20970000 K8=K8+1 20980000 640 CONTINUE 20990000 C 21000000 641 CONTINUE 21010000 C 21020000 IF ( I8 .NE. TRCCNT) GO TO 650 21030000 C 21040000 XMAX= 0.0 21050000 DO 642 J8=1,NFTPTS 21060000 642 XMAX= AMAX1(XMAX,XCOM(FFT1+J8-1)) 21070000 C 21080000 IF (NORM.EQ.0) THEN 21090000 C 21100000 CC SCF = AMPREC/((XMAX*AMPREC)/GRPCNT) 21110000 SCF = FLOAT(GRPCNT)/XMAX 21120000 AVGP= FLOAT(GRPCNT)/(XMAX*AMPREC) 21130000 C 21140000 ELSE 21150000 C 21160000 XMX = TOTLOG/FLOAT(GRPCNT) 21170000 AVGP = SR*(10.**XMX) 21180000 SCF = AMPREC*AVGP 21190000 IF (ANRMSF .NE. 0.0) SCF = ANRMSF 21200002 WRITE (KPPRNT,9180) SCF 21210000 C 21220000 ENDIF 21230000 C 21240000 XFA = XMAX*SCF/FLOAT(GRPCNT) 21250000 CFALOG = ALOG10(XFA) 21260000 N = CFALOG + 1.999 21270000 AAXIS(3) = 10.**(N-6) 21280000 LOWBND = 1.05*AAXIS(3) 21290000 C 21300000 SCF2 = SCF*SCF 21310000 CALL ARMPFC ( XCOM(FFT1),XCOM(FFT1),SCF ,NFTPTS) 21320000 CALL ARMPFC ( XCOM(FFT3),XCOM(FFT3),SCF2,NFTPTS) 21330000 C 21340000 GO TO 650 21350000 C 21360000 645 CONTINUE 21370000 C 21380000 C 21390000 C SAVE BOTH COMPLEX AVERAGE SPECTRUM AND AVERAGE 21400000 C AMPLITUDE SPECTRUM FOR X-CORS. 21410000 C ALSO RECALL THAT THE POWER SPECTRUM OF THE OPPOSITE 21420000 C CROSS-CORRELATION IS THE COMPLEX CONJ OF THE FIRST 21430000 C 21440000 C SUMMARY OF OPERATIONS: 21450000 C 21460000 C FFTEM = FFTEM * SCF (AMPLITUDE RECOVERY ) 21470000 C FFTBUF(5) = FFTBUF(5) + FFTEM (AVG COMPLEX SPECTRUM) 21480000 C FFTBUF(5) = FFTBUF(5) + FFTEM* (CONJUGATE ADD) 21490000 C FFTEM = | FFTEM |**2 (POWER SPECTRUM) 21500000 C FFTBUF(3) = FFTBUF(3) + FFTEM (ORIG POWER) 21510000 C FFTBUF(3) = FFTBUF(3) + FFTEM (OPPOSITE XCOR POWER) 21520000 C FFTEM = | FFTEM | (AMP SPECTRUM) 21530000 C FFTBUF(1) = FFTBUF(1) + FFTEM (AVG AMP SPECTRUM) 21540000 C 21550000 CALL ARMPFC( XCOM(FFTEM), XCOM(FFTEM), SCF ,LFOUR2) 21560000 CALL ARADC ( XCOM(FFTEM), XCOM(FFT5 ), XCOM(FFT5) ,NFTPTS) 21570000 CALL ARADCC( XCOM(FFT5) , XCOM(FFTEM), XCOM(FFT5) ,NFTPTS) 21580000 CALL ARPOW ( XCOM(FFTEM), XCOM(FFTEM), NFTPTS) 21590000 CALL ARADF ( XCOM(FFTEM), XCOM(FFT3 ), XCOM(FFT3 ),NFTPTS) 21600000 CALL ARADF ( XCOM(FFTEM), XCOM(FFT3) , XCOM(FFT3) ,NFTPTS) 21610000 CALL ARSQRT( XCOM(FFTEM), XCOM(FFTEM), NFTPTS) 21620000 CALL ARADF ( XCOM(FFTEM), XCOM(FFT1) , XCOM(FFT1) ,NFTPTS) 21630000 CALL ARADF ( XCOM(FFTEM), XCOM(FFT1) , XCOM(FFT1) ,NFTPTS) 21640000 C 21650000 C 21660000 650 CONTINUE 21670000 C 21680000 C ==================================================================== 21690000 C END OF MAIN LOOP FOR EACH OFFSET GROUP 21700000 C ==================================================================== 21710000 C 21720000 C CALCULATE STANDARD DEV. AND PLOT RESULTS 21730000 C FOR EACH CORRELATION OFFSET GROUP 21740000 C 21750000 660 CONTINUE 21760000 C 21770000 ALNAV = ALNAV/GRPCNT 21780000 IF ( (PLTYPE .EQ. 2) .AND. (I7 .NE. 0) ) GO TO 698 21790000 C 21800000 C 21810000 C SUMMARY OF OPERATIONS: 21820000 C 21830000 C FFTBUF(2) = FFTBUF(1) * FFTBUF(1) (SUM X)*(SUM X) 21840000 C FFTBUF(2) = FFTBUF(2) / GRPCNT (SUM X)**2 / N 21850000 C FFTBUF(3) = FFTBUF(3) - FFTBUF(2) SUM(X**2)-N*(SUMX/N)**2 21860000 C FFTBUF(1) = FFTBUF(1) / GRPCNT MEAN 21870000 C FFTBUF(3) = FFTBUF(3) / GRPCNT VARIANCE 21880000 C FFTBUF(3) = |FFTBUF(3)| STANDARD DEV 21890000 C FFTBUF(2) = FFTBUF(1) + FFTBUF(3) MEAN + STD DEV 21900000 C FFTBUF(4) = FFTBUF(1) - FFTBUF(3) MEAN - STD DEV 21910000 C 21920000 CALL ARMPF ( XCOM(FFT1), XCOM(FFT1), XCOM(FFT2 ), NFTPTS ) 21930000 CALL ARDVFC( XCOM(FFT2), XCOM(FFT2), FLOAT(GRPCNT),NFTPTS ) 21940000 CALL ARSBF ( XCOM(FFT3), XCOM(FFT2), XCOM( FFT3), NFTPTS ) 21950000 CALL ARDVFC( XCOM(FFT1), XCOM(FFT1), FLOAT(GRPCNT),NFTPTS ) 21960000 CALL ARDVFC( XCOM(FFT3), XCOM(FFT3), FLOAT(GRPCNT),NFTPTS ) 21970000 C 21980000 C CULL OUT NEGATIVE SQUARE ROOTS 21990000 DO 662 J8=1,NFTPTS 22000000 IF ( XCOM(FFT3+J8-1).LT. 0.) XCOM(FFT3+J8-1)=0.0 22010000 662 CONTINUE 22020000 C 22030000 CALL ARSQRT( XCOM(FFT3), XCOM(FFT3 ), NFTPTS ) 22040000 CXOUT CALL ARADF ( XCOM(FFT1), XCOM(FFT3), XCOM(FFT2), NFTPTS ) 22050000 CXOUT CALL ARSBF ( XCOM(FFT1), XCOM(FFT3), XCOM(FFT4), NFTPTS ) 22060000 C 22070000 C 22080000 GRPHNO = 5 22090000 PNUMP(5) = 1 22100000 C 22110000 C SKIP FOR AUTOCORS 22120000 C 22130000 IF ( I7 .EQ. 0 ) GO TO 665 22140000 C 22150000 C SUMMARY OF OPERATIONS: 22160000 C 22170000 C FFTBUF(5) = |FFTBUF(5)|**2 POWER OF AVG COMPLEX SPEC 22180000 C FFTBUF(5) = |FFTBUF(5)| AMP OF AVG COMPLEX SPEC 22190000 C FFTSUM = FFTSUM + FFTBUF(5) AMP SUM 22200000 C FFTBUF(5) = FFTBUF(5)/GRPCNT RMS SPEC AMP 22210000 C 22220000 CALL ARPOW ( XCOM(FFT5), XCOM(FFT5), NFTPTS ) 22230000 CALL ARSQRT ( XCOM(FFT5), XCOM(FFT5), NFTPTS ) 22240000 CXOUT CALL ARADF ( XCOM(FFT5),XCOM(SUM),XCOM(SUM),NFTPTS) 22250000 CALL ARDVFC ( XCOM(FFT5),XCOM(FFT5),FLOAT(GRPCNT),NFTPTS) 22260000 C 22270000 PNUMP(5)=NFTCUT 22280000 C 22290000 665 CONTINUE 22300000 C 22310000 C 22320000 C KEEP THE PLOTS WITHIN BOUNDS 22330000 C 22340000 INDX = FFT1-1 22350000 DO 670 K8=1,GRPHNO 22360000 DO 668 J8=1,NFTPTS 22370000 CX IF ( XCOM(INDX+J8) .GT. 9.9 ) XCOM(INDX+J8) = 9.9 22380000 IF ( XCOM(INDX+J8) .LT. LOWBND ) XCOM(INDX+J8) = LOWBND22390000 668 CONTINUE 22400000 INDX = INDX+LFOUR2 22410000 670 CONTINUE 22420000 C 22430000 CXOUT IF(I7.EQ.0) AVCN = AVC0 22440000 CXOUT IF(I7.EQ.0) AVPN = AVP0 22450000 CXOUT IF(I7.EQ.0) RATN = RAT0 22460000 C 22470000 C SAVE THE AVERAGE AUTO-POWER SPECTRUM OR CROSS-AMP 22480000 C AND THE AVERAGE AMPLITUDE SPECTRUM FOR EACH OFFSET 22490000 C 22500000 IF ( I7 .EQ. 0 ) THEN 22510000 CALL ARMVE ( XCOM(FFT1), XCOM(AVC0), NFTPTS ) 22520000 CXMOV CALL ARDVF ( XCOM(FFT1), XCOM(FFT3), XCOM(RATN),NFTPTS) 22530000 CALL ARDVF ( XCOM(FFT1), XCOM(FFT3), XCOM(RAT0),NFTPTS) 22540000 CXOUT ELSE 22550000 CXOUT CALL ARMVE ( XCOM(FFT5), XCOM(AVCN), NFTPTS ) 22560000 ENDIF 22570000 C 22580000 CXOUT CALL ARMVE ( XCOM(FFT1), XCOM(AVPN), NFTPTS ) 22590000 CALL ARSET ( XCOM(FFT6), NFTPTS, AVGP ) 22600000 C 22610000 C FOR SHORT OUTPUT DO NOT PLOT THE OFFSET GROUP 22620000 C 22630000 IF ( PLTYPE .EQ. 2 ) GO TO 690 22640000 C 22650000 C CHECK TO SEE IF THIS OFFSET GROUP IS TO BE PLOTTED 22660000 C FOR INDIVIDUAL CROSS-CORRELATION PLOTS 22670000 C 22680000 IF (I7 .EQ. 0) GO TO 684 22690000 DO 683 JOFF=1,NDIF 22700000 IF(OFFDIF( JOFF) .EQ. (I7 )) GO TO 684 22710000 683 CONTINUE 22720000 GO TO 690 22730000 684 CONTINUE 22740000 C 22750000 C SET THE TITLES FOR THE GRAPH 22760000 C 22770000 LABELT( 1:64) = LABEL1(1:64) 22780000 LABELT(65:128)= LABEL4(1:64) 22790000 LABELY( 1:64) = LABEL3(1:64) 22800000 LABELY(33:36) = COMMA (1: 4) 22810000 C 22820000 CALL S1BNCV ( TRCCNT , LABELY, 9, 4 ) 22830000 CALL S1BNCV ( GRPCNT/2, LABELY, 37, 4 ) 22840000 CALL S1BNCV ( I7 , LABELT, 18, 1 ) 22850000 CALL S1BNCV ( NSTIME , LABELT, 73, 4 ) 22860000 CALL S1BNCV ( NETIME , LABELT, 84, 4 ) 22870000 C 22880000 LABELT(33:40) = PRMODE(1:8) 22890000 LABELL(6)(1:8) = AVGPOW(1:8) 22900000 C 22910000 IF ( MAXSDP .EQ. MINSDP ) GO TO 682 22920000 LABELT(46:48) = DASH(1:3) 22930000 CALL S1BNCV ( MAXSDP, LABELT, 49, 4 ) 22940000 682 CONTINUE 22950000 C 22960000 CALL S1BNCV ( MINSDP, LABELT, 42, 4 ) 22970000 C 22980000 PNUMP(2) = 1 22990000 PNUMP(4) = 1 23000000 C 23010000 CALL SACOR1(XCOM(FFT1),COM(PLTBUF),GRPHNO,PNUMP(1),LABELX , 23020000 * LABELY ,IPLT,AAXIS(1),LABELL ,LABELT , 23030000 * 0,ITYPE(1),NFREQ,GRID,XCOM(SCR1),XCOM(SCR2) ) 23040000 C 23050000 C SELECT THE CORRECT VALUES OF XMAX,YMAX DEPENDING ON IPLT 23060000 C 23070000 CX IF (IPLT .EQ. 2) THEN 23080000 CX CALL SACOR3 (15.0,09.5,.14) 23090000 CX ELSE IF (IPLT .EQ. 6) THEN 23100000 CALL SACOR3 (AAXIS(4),AAXIS(1)*AAXIS(2),.14) 23110000 CX END IF 23120000 C 23130000 LABELL(6)(1:8) = BLANKS(1:8) 23140000 C 23150000 690 CONTINUE 23160000 C 23170000 PNUMP(2) = NFTCUT 23180000 PNUMP(4) = NFTCUT 23190000 PNUMP(5) = NFTCUT 23200000 C 23210000 C STORE THE RATIO OF AVERAGE POWER (SIGNAL+NOISE FOR 23220000 C AUTO-POWER TERM) TO THE STANDARD DEVIATION 23230000 C 23240000 CXMOV CALL ARDVF ( XCOM(FFT1), XCOM(FFT3), XCOM(RATN),NFTPTS) 23250000 C 23260000 698 CONTINUE 23270000 C 23280000 IF (I7 .EQ. 0) GO TO 701 23290000 C 23300000 CXOUT LFOUR1 = LFOUR-1 23310000 CXOUT XCOM(CRANV2) = XCOM(CRANV) 23320000 CXOUT CALL ARFLP ( XCOM(CRANV+1), XCOM(CRANV2+1), LFOUR1 ) 23330000 C 23340000 C FIND THE UNIT NORMALIZED CROSS-CORR COEFF FOR THIS OFFSET GROUP 23350000 C 23360000 CX IF (NORM .EQ. 0) THEN 23370000 XCRANV = XCOEFF / FLOAT(GRPCNT) 23380000 CX ELSE 23390000 CX XCRANV =((2.0*XCOM(CRANV))/FLOAT(GRPCNT))/(0.1*FLOAT(NORM)) 23400000 CX ENDIF 23410000 C 23420000 C 23430000 IF(STACK .EQ. 0) WRITE(KPPRNT,9150) I7,XCRANV,GRPCNT/2 23440000 C 23450000 IF(STACK .NE. 0) 23460000 * WRITE(KPPRNT,9160) I7,XCRANV,GRPCNT/2 23470000 C 23480000 C SAVE TOTAL NORMALIZED CROSS-CORR COEFF IN TCOEFF 23490000 C ADD FORWARD XCOR TO RUNNING TOTAL FOR ALL OFFSET GROUPS 23500000 C ADD OPPOSITEXCOR TO RUNNING TOTAL FOR ALL OFFSET GROUPS 23510000 C 23520000 TCOEFF = TCOEFF + XCOEFF 23530000 CALL ARADF (XCOM(CORRX1), XCOM(CRANV ), XCOM(CORRX1), LFOUR) 23540000 CXOUT CALL ARADF (XCOM(CORRX2), XCOM(CRANV2), XCOM(CORRX2), IBUFF) 23550000 C 23560000 701 CONTINUE 23570000 C 23580000 IF (KPBUGF.GE.3) 23590000 * WRITE(KPPRNT,9720) I7,XCOEFF,XCOM(CRANV),TCOEFF,XCRANV 23600000 9720 FORMAT(' I7 :', I6,6X, 23610000 * ' XCOEFF,XCOM(CRANV),TCOEFF,XCRANV:',4E15.7 ) 23620000 C 23630000 I7 = I7 + 1 23640000 GO TO 550 23650000 C 23660000 C =================================================================== 23670000 C END OF OFFSET ITERATION LOOP 23680000 C =================================================================== 23690000 C 23700000 700 CONTINUE 23710000 C 23720000 CX IF (NORM .EQ. 0) THEN 23730000 XCRANV = TCOEFF / FLOAT(CORCNT) 23740000 CX ELSE 23750000 CX XCRANV = ((2.0*XCOM(CORRX1)) / FLOAT(CORCNT))/ 23760000 CX + (0.1*FLOAT(NORM)) 23770000 CX ENDIF 23780000 C 23790000 WRITE(KPPRNT,9170) XCRANV,CORCNT/2 23800000 C 23810000 DO 702 K8=1,11 23820000 ITYPE(K8) = 2 23830000 702 CONTINUE 23840000 C 23850000 C =================================================================== 23860000 C PLOT AUTO AND CROSS POWER 23870000 C =================================================================== 23880000 C 23890000 C 23900000 CXOUT IF ( PLTYPE .NE. 2 ) GO TO 730 23910000 C 23920000 IF ( CORCNT .EQ. 0 ) GO TO 711 23930000 C 23940000 C RECALL THAT CORRX1 CONTAINS ONLY THE CROSS-CORRELATIONS 23950000 C FOR THE FORWARD CROSS-CORRELATION AND DOES NOT INCLUDE 23960000 C THE OPPOSITE CROSS-CORRELATION. 23970000 C 23980000 DO 705 J8=1,LFOUR 23990000 XCOM(FFTEM+J8-1) = XCOM(CORRX1+J8-1)*XCOM(EXPWIN+J8-1)*SCF 24000000 705 CONTINUE 24010000 C 24020000 CALL S2DFT2 ( MAG,XCOM(FFTEM), * 1820) 24030000 C 24040000 CALL ARADCC (XCOM(FFTEM),XCOM(FFTEM),XCOM(FFTEM),NFTPTS) 24050000 CALL ARDVFC ( XCOM(FFTEM), XCOM(FFTEM), 24060000 * FLOAT(CORCNT), LFOUR2 ) 24070000 CALL ARPOW (XCOM(FFTEM),XCOM(AVC1),NFTPTS) 24080000 CALL ARSQRT (XCOM(AVC1 ),XCOM(AVC1),NFTPTS) 24090000 C 24100000 DO 710 J8=1,NFTPTS 24110000 IF(XCOM(AVC1+J8-1).LT.LOWBND) XCOM(AVC1+J8-1)=LOWBND 24120000 CX IF(XCOM(AVC1+J8-1).GT.UPPBND) XCOM(AVC1+J8-1)=UPPBND 24130000 710 CONTINUE 24140000 C 24150000 711 CALL ARSET ( XCOM(AVC3),NFTPTS,AVGP ) 24160000 C 24170000 ITYPE(1) = 3 24180000 ITYPE(2) = 3 24190000 ITYPE(3) = 2 24200000 ITYPE(4) = 1 24210000 C 24220000 C SET LABELS FOR THE PLOT 24230000 C 24240000 LABELY( 1:64) = LABEL3( 1:64) 24250000 LABELY(33:36) = COMMA ( 1: 4) 24260000 CALL S1BNCV ( TRCCNT , LABELY, 9, 4 ) 24270000 CALL S1BNCV ( CORCNT/2, LABELY, 37, 4 ) 24280000 LABELT( 1:64) = LABEL9( 1:64) 24290000 LABELT(65:128)= LABEL4( 1:64) 24300000 C 24310000 LABELT(41:48) = PRMODE(1:8) 24320000 LABELL(4)( 1: 8) = AVGPOW(1:8) 24330000 C 24340000 IF ( MAXSDP .NE. MINSDP ) THEN 24350000 LABELT(54:56) = DASH(1:3) 24360000 CALL S1BNCV ( MAXSDP, LABELT, 57, 4 ) 24370000 ENDIF 24380000 CALL S1BNCV ( MINSDP, LABELT, 50, 4 ) 24390000 CALL S1BNCV ( NSTIME, LABELT, 73, 4 ) 24400000 CALL S1BNCV ( NETIME, LABELT, 84, 4 ) 24410000 C 24420000 C PLOT AUTO-SPECTRUM AND CROSS-SPECTRUM 24430000 C 24440000 TEMPO = 3 24450000 C 24460000 PNUMP(3) = 1 24470000 IF ( CORCNT .EQ. 0 ) PNUMP(2) = 1 24480000 C 24490000 IF (KPBUGF.GE.2) THEN 24500000 WRITE(KPPRNT,4141) (XCOM(AVC0+JJJ-1),JJJ=1,NFTPTS) 24510000 IF (TEMPO.GE.2 ) 24520000 * WRITE(KPPRNT,4142) (XCOM(AVC1+JJJ-1),JJJ=1,NFTPTS) 24530000 ENDIF 24540000 4141 FORMAT(' AVC0: ',10E12.5) 24550000 4142 FORMAT(' AVC1: ',10E12.5) 24560000 C 24570000 CALL SACOR1 ( XCOM(AVC0) , XCOM(PLTBUF),TEMPO, PNUMP(1), 24580000 * LABELX , LABELY ,IPLT, AAXIS(1), LABELL , 24590000 * LABELT , 0, ITYPE(1), NFREQ, GRID, 24600000 * XCOM(SCR1), XCOM(SCR2) ) 24610000 C 24620000 C WRITE OUT PLOT LEGEND FOR POWER SPECTRUM 24630000 C SELECT THE CORRECT VALUES OF XMAX,YMAX DEPENDING ON IPLT 24640000 C 24650000 CX IF (IPLT .EQ. 2) THEN 24660000 CXX CALL LEGEN2 (15.0,09.5,.14) 24670000 CX CALL SACOR4 (15.0,09.5,.14) 24680000 CX ELSE IF (IPLT .EQ. 6) THEN 24690000 CALL SACOR4 (AAXIS(4),AAXIS(1)*AAXIS(2),.14) 24700000 CX END IF 24710000 C 24720000 PNUMP(2) = NFTCUT 24730000 PNUMP(3) = NFTCUT 24740000 LABELL(4)( 1: 8) = BLANKS(1:8) 24750000 C 24760000 C ================================================================== 24770000 C PLOT THE MEAN AUTO-POWER/STAND.DEV. RATIO 24780000 C ================================================================== 24790000 C 24800000 LABELT( 1:64) = LABEL7( 1:64) 24810000 LABELY( 1:64) = LABEL7( 1:64) 24820000 LABELT(41:48) = PRMODE( 1: 8) 24830000 C 24840000 IF ( MAXSDP .NE. MINSDP ) THEN 24850000 LABELT(54:56) = DASH(1:3) 24860000 CALL S1BNCV ( MAXSDP, LABELT, 57, 4 ) 24870000 ENDIF 24880000 C 24890000 CALL S1BNCV ( MINSDP, LABELT, 50, 4 ) 24900000 C 24910000 C THEORETICAL VALUE FOR WHITE GAUSSIAN NOISE 24920000 LABELL(2)(1:8) = GAUSS(1:8) 24930000 CALL ARSET ( XCOM(RAT1), NFTPTS, NRAT ) 24940000 C 24950000 ITYPE(1) = 3 24960000 ITYPE(2) = 1 24970000 C 24980000 AAXIS(1) = 25.0*FLOAT(MAXFRQ)/FLOAT(NYFREQ) 24990000 AAXIS(2) = 0.0 25000000 AAXIS(3) = 0.04*FLOAT(NYFREQ) 25010000 AAXIS(4) = 10.0 25020000 AAXIS(5) = 0.0 25030000 AAXIS(6) = 1.0 25040000 C 25050000 C DETERMINE IF LINEAR PLOT SCALES ARE TO BE DEFAULT VALUES 25060000 C OR IF THEY ARE SET BY AAXIS. IF ISHORT = 0 THEN USE THE 25070000 C AAXIS VALUES. IPLT IS SET TO 4 IF ISHORT NE 0 AND TO 8 25080000 C IF ISHORT = 0. 25090000 C 25100000 CX IF(ISHORT .EQ. 0) THEN 25110000 IPLT = 8 25120000 CX ELSE 25130000 CX IPLT = 4 25140000 CX END IF 25150000 C 25160000 IF (KPBUGF.GE.2) THEN 25170000 WRITE(KPPRNT,4143) (XCOM(RAT0+JJJ-1),JJJ=1,NFTPTS) 25180000 WRITE(KPPRNT,4144) (XCOM(RAT1+JJJ-1),JJJ=1,NFTPTS) 25190000 ENDIF 25200000 4143 FORMAT(' RAT0: ',10E12.5) 25210000 4144 FORMAT(' RAT1: ',10E12.5) 25220000 C 25230000 C MAKE SURE THE VALUES STAY WITHIN PLOTTING RANGE 25240000 C 25250000 DO 720 J8=1,NFTPTS 25260000 IF (XCOM(RAT0+J8-1).GT.9.95) XCOM(RAT0+J8-1)=9.95 25270000 IF (XCOM(RAT0+J8-1).LT.0.05) XCOM(RAT0+J8-1)=0.05 25280000 720 CONTINUE 25290000 C 25300000 COUT CALL SACOR1 ( XCOM(RAT0 ), XCOM(PLTBUF),2, PNUMP(1), 25310000 COUT * LABELX , LABELY ,IPLT, AAXIS(1), LABELL , 25320000 COUT * LABELT , 0, ITYPE(1), NFREQ, GRID , 25330000 COUT * XCOM(SCR1), XCOM(SCR2) ) 25340000 C 25350000 LABELL(2)( 1: 8) = BLANKS(1:8) 25360000 C 25370000 C ==================================================================== 25380000 C FIND AND PLOT THE SIGNAL-TO-NOISE RATIO FROM THE 25390000 C AUTO AND CROSS CORRELATIONS 25400000 C ==================================================================== 25410000 C 25420000 IF ( MAXCRO .EQ. 0 ) GO TO 790 25430000 C 25440000 CALL ARSBF ( XCOM(AVC0),XCOM(AVC1),XCOM(AVC3),NFTPTS ) 25450000 CALL ARDVF ( XCOM(AVC1),XCOM(AVC3),XCOM(RAT0),NFTPTS ) 25460000 C 25470000 LABELT( 1:64) = LABEL8( 1:64) 25480000 LABELY( 1:64) = LABEL8( 1:64) 25490000 LABELT(37:44) = PRMODE( 1: 8) 25500000 C 25510000 IF ( MAXSDP .NE. MINSDP ) THEN 25520000 LABELT(50:52) = DASH(1:3) 25530000 CALL S1BNCV ( MAXSDP, LABELT, 53, 4 ) 25540000 ENDIF 25550000 CALL S1BNCV ( MINSDP, LABELT, 46, 4 ) 25560000 C 25570000 ITYPE(1) = 3 25580000 ITYPE(2) = 2 25590000 C 25600000 IF (KPBUGF.GE.2) THEN 25610000 WRITE(KPPRNT,4145) (XCOM(RAT0+JJJ-1),JJJ=1,NFTPTS) 25620000 ENDIF 25630000 4145 FORMAT(' RAT0: ',10E12.5) 25640000 C 25650000 DO 725 J8=1,NFTPTS 25660000 IF ( XCOM(RAT0+J8-1) .LT. 0.0 .AND. 25670000 * XCOM(AVC0+J8-1) .GT. 0.01*XFA ) 25680000 * XCOM(RAT0+J8-1) = 9.95 25690000 IF ( XCOM(RAT0+J8-1) .GT. 9.95 ) XCOM(RAT0+J8-1) = 9.95 25700000 IF ( XCOM(RAT0+J8-1) .LT. 0.05 ) XCOM(RAT0+J8-1) = 0.05 25710000 IF ( XCOM(RAT1+J8-1) .GT. 9.95 ) XCOM(RAT1+J8-1) = 9.95 25720000 IF ( XCOM(RAT1+J8-1) .LT. 0.05 ) XCOM(RAT1+J8-1) = 0.05 25730000 725 CONTINUE 25740000 C 25750000 C 25760000 PNUMP(2) = 1 25770000 LABELL(1)(1:8) = BLANKS(1:8) 25780000 CALL SACOR1 ( XCOM(RAT0), XCOM(PLTBUF), 1, PNUMP(1), 25790000 * LABELX , LABELY ,IPLT, AAXIS(1), LABELL , 25800000 * LABELT , 0, ITYPE(1), NFREQ, GRID, 25810000 * XCOM(SCR1), XCOM(SCR2) ) 25820000 C 25830000 790 CONTINUE 25840000 C 25850000 C =================================================================== 25860000 C ANALYSIS RESET AND RESUME 25870000 C =================================================================== 25880000 C 25890000 850 CONTINUE 25900000 C 25910000 KPMOTF = 0 25920000 C 25930000 IF (OPNFLG .NE. 0) THEN 25940000 CALL PLOT (0.0,0.0,998) 25950000 OPNFLG = 0 25960000 KPTRIO = KPTRIO + 1 25970000 END IF 25980000 C 25990000 IF (KPMITF .EQ. 0) THEN 26000000 KPLOTF = 0 26010000 KPRTF = 0 26020000 ELSE 26030000 DAWRK = 1 26040000 SPDPCT= 0 26050000 NOWIN = 0 26060000 CALL ARMVE (COM(TRCSAV),OH ,TRCLEN) 26070000 GO TO 120 26080000 END IF 26090000 C 26100000 GO TO 900 26110000 C 26120000 C =================================================================== 26130000 C FORMAL CLOSEOUT 26140000 C =================================================================== 26150000 C 26160000 875 KPLOTF = 0 26170000 KPRTF = 0 26180000 C 26190000 900 CONTINUE 26200000 C 26210000 CALL ARMVE (DLOCAL,COM(KPIRSM),LLOCAL) 26220000 C 26230000 IF ( (KPRTF .NE. -1) .AND. (KPLOTF .NE. 0) ) GO TO 1000 26240000 C 26250000 IF (KPTRIO .GT. 0) THEN 26260000 CALL PLOT (0.,0.,999) 26270000 PROCFL = 0 26280000 CALL USDDNV(DDNMO,COM(KPVOLS+2),COM(KPVOLS),IER) 26290000 GO TO ( 960, 930, 940, 950), IER 26300000 930 WRITE(KPPRNT,9931) DDNMO 26310000 GO TO 1000 26320000 940 WRITE(KPPRNT,9941) DDNMO 26330000 GO TO 1000 26340000 950 WRITE(KPPRNT,9951) DDNMO 26350000 ELSE 26360000 PROCFL = 0 26370000 END IF 26380000 C 26390000 C UNALLOCATE THE WORK FILE 26400000 C 26410000 960 IF (WRKALO .EQ. 1) THEN 26420000 CALL FOCDD (KPWRKD) 26430000 CALL UGUWRK (KPWRKS, KPWRKD, ERR, ERIN) 26440000 IF (ERR .EQ. 1) THEN 26450000 WRKALO = 0 26460000 ELSE 26470000 WRITE (KPPRNT, 9996) ERR, ERIN 26480000 KPRTF = -1 26490000 ENDIF 26500000 ENDIF 26510000 C 26520000 C UNALLOCATE THE PLOT FILE 26530000 C 26540000 IF (DYNAMF .EQ. 1) THEN 26550000 IF (KPRTF .EQ. -1) CALL FOCWTR (KPDBGS, ERR) 26560000 CALL UGUNAL (KPDBGS, ERR, ERIN) 26570000 IF (ERR .EQ. 1) THEN 26580000 DYNAMF = 0 26590000 ELSE 26600000 WRITE (KPPRNT, 9998) ERR, ERIN 26610000 KPRTF = -1 26620000 KPDBGA = 0 26630000 KPDBGN = 0 26640000 GO TO 1000 26650000 ENDIF 26660000 ENDIF 26670000 C 26680000 C ADD OUTPUT DATA SET TO THE PLOT QUEUE 26690000 C 26700000 IF (KPTRIO .GT. 0) THEN 26710000 CALL UPAPLT (COM(KPIUSM), DSNAME, X) 26720000 COM(KPDSNS) = 1 26730000 COM(KPDSNS+1) = 1 26740000 CALL S1MVCH (DSNAME, 5, COM(KPDSNS+2), 1, 8) 26750000 KPDBGA = 0 26760000 KPDBGN = 0 26770000 ENDIF 26780000 C 26790000 1000 CONTINUE 26800000 C 26810000 1005 RETURN 26820000 C 26830000 C =================================================================== 26840000 C WRITE STMTS, FORMATS, ERRORS, ETC. 26850000 C =================================================================== 26860000 C 26870000 1820 WRITE (KPPRNT, 9820 ) 26880000 KPRTF = -1 26890000 GO TO 900 26900000 C 26910000 1830 WRITE (KPPRNT, 9825 ) SHOT1,SHOT2,SPDPCT 26920000 FLAN = 0 26930000 DAWRK = 1 26940000 NOWIN = 0 26950000 SPDPCT= 0 26960000 GO TO 135 26970000 C 26980000 1910 WRITE (KPPRNT, 9910 ) 26990000 KPRTF = -1 27000000 GO TO 900 27010000 C 27020000 1920 WRITE (KPPRNT, 9920 ) 27030000 WRITE (KPPRNT, 9925 ) 27040000 KPRTF = -1 27050000 GO TO 900 27060000 C 27070000 1930 WRITE (KPPRNT, 9930 ) 27080000 KPRTF = -1 27090000 GO TO 900 27100000 C 27110000 C1940 WRITE (KPPRNT, 9940 ) 27120000 C GO TO 900 27130000 C 27140000 1950 CORMSG = CORMSG+1 27150000 IF (CORMSG.LE.10) 27160000 *WRITE (KPPRNT, 9950 ) 27170000 GO TO 450 27180000 C 27190000 C1960 WRITE (KPPRNT, 9960 ) 27200000 C GO TO 900 27210000 C 27220000 C1990 WRITE (KPPRNT, 9990 ) 27230000 C KPRTF = -1 27240000 C GO TO 900 27250000 C 27260000 1992 WRITE (KPPRNT, 9992 ) IER, IERN 27270000 KPRTF = -1 27280000 GO TO 900 27290000 C 27300000 1994 WRITE (KPPRNT, 9994 ) ERR, ERIN 27310000 KPRTF = -1 27320000 GO TO 900 27330000 C 27340000 C 27350000 C 27360000 C *************************************************************** 27370000 C * * 27380000 C * *********************** * 27390000 C * * FORMAT STATEMENTS * * 27400000 C * *********************** * 27410000 C * * 27420000 C ********* ********* 27430000 C 27440000 8000 FORMAT ('0',70('*')/' *** OUTPUT DATA SET = ',A44,' ***'/ 27450000 * ' ',70('*')/ ) 27460000 C 27470000 9020 FORMAT('0COUNT',4X,A8,'S PROCESSED',/) 27480000 C 27490000 9030 FORMAT(1X,I4,4(2X,6I5)) 27500000 C 27510000 9040 FORMAT('0') 27520000 C 27530000 9100 FORMAT('0 *** ATTEMPTING TO USE START TIME MOVE OUT VEL',I7, 27540000 + ' WITH AN NMO TRACE HEADER FLAG NMF=',I5,' ABORT CONDITION ***') 27550000 C 27560000 9110 FORMAT('0 *** ATTEMPTING TO USE END TIME MOVE OUT VEL',I7, 27570000 + ' WITH AN NMO TRACE HEADER FLAG NMF=',I5,' ABORT CONDITION ***') 27580000 C 27590000 9120 FORMAT('0',///' *** MULTI-TRACE SPECTRAL ANALYSIS FOR ',A8, 27600000 * I6,' -',I6,' ***'//) 27610000 C 27620000 9150 FORMAT(' THE AVERAGE CROSS-CORRELATION COEFFICIENT (CENT', 27630000 * 'ER LAG VALUE) FOR OFFSET GROUP =',I3,' IS',1PE12.5,' FOR',I6, 27640000 * ' CROSS-CORRELATIONS') 27650000 C 27660000 9160 FORMAT(' THE AVERAGE CROSS-CORRELATION COEFFICIENT (CENT', 27670000 * 'ER LAG VALUE) FOR CDP OFFSET =',I5,' IS',1PE12.5,' FOR',I6, 27680000 * ' CROSS-CORRELATIONS') 27690000 C 27700000 9170 FORMAT(' THE AVERAGE CROSS-CORRELATION COEFFICIENT (CENT', 27710000 * 'ER LAG VALUE) FOR ALL OFFSETS IS',1PE12.5, 27720000 * ' FOR',I6,' CROSS-CORRELATIONS' ) 27730000 C 27740000 9180 FORMAT(' THE ABSOLUTE NORMALIZATION SCALE FACTOR IS ', 27750000 * 1PE12.5) 27760000 C 27770000 C9240 FORMAT ('0 *** TRACE OFFSET OF',I10,' DOES NOT AGREE WITH', 27780000 CX * ' ALLOWED OFFSETS ***') 27790000 C 27800000 9820 FORMAT ('0*** FFT ERROR RETURN: BAD SINCOS TABLE ***') 27810000 C 27820000 9825 FORMAT ('0*** LAST GROUP IN RANGE ',I5,' TO ',I5,' SKIPPED.', 27830000 * ' *** TOO FEW RECORDS (', I3, ') IN GROUP') 27840000 C 27850000 9830 FORMAT (' FFTBUF (',I3,',',I3,' ) =',E12.5) 27860000 C 27870000 9840 FORMAT (' ALIGNMENT MAX. ON EDGE OF RANGE:',I4) 27880000 C 27890000 9850 FORMAT (' CORRELATION TRUNCATED AT 1023RD SAMPLE') 27900000 C 27920000 9910 FORMAT ('0*** NOT ENOUGH MEMORY AVAILABLE ***') 27930000 C 27940000 9920 FORMAT ('0*** STARTING, ENDING RANGES ON PARAMETER CARDS ***') 27950000 C 27960000 9925 FORMAT (' *** NOT THOSE IN INDEXING ARRAY--BAD ERROR. ***') 27970000 C 27980000 9930 FORMAT ('0*** ERROR IN FORP PARAMETER READ--BAD ERR. ***') 27990000 C 28000000 9931 FORMAT ('0*** NO DD-CARD PRESENT WITH DDNAME ***',2A4) 28010000 C 28020000 9940 FORMAT ('0$$$$ LOOKS LIKE ITS ENDING IN THE NORMAL WAY! $$$$') 28030000 C 28040000 9941 FORMAT ('0*** NO OUTPUT REELS FOR FILE WITH DDNAME ***',2A4) 28050000 C 28060000 9950 FORMAT ('0=== OUTPUT TRACE NOT LONG ENOUGH FOR X-COR. ===') 28070000 C 28080000 9951 FORMAT ('0*** MORE THAN 5 REELS FOR FILE WITH DDNAME ***',2A4) 28090000 C 28100000 9960 FORMAT ('0*** CORRELATION SUBROUTINE DID NOT RETURN--BAD ***') 28110000 C 28120000 9970 FORMAT ('0*** LESS THAN TWO VALID TRACES IN ANALYSIS GROUP**') 28130000 C 28140000 9980 FORMAT ('0*** PROGRAM ATTEMPTS TO RESERVE MORE THAN 2000 WINDOWS',28150000 * ' 2000 HAVE BEEN USED') 28160000 C 28170000 9985 FORMAT ('0*** WINDOW LENGTHS WERE SWITCHED BEFORE X-COR ***') 28180000 C 28181003 9990 FORMAT ('0*** ANALYSIS TYPE NOT RECOGNIZED--BAD ERROR ***') 28190000 C 28200000 9992 FORMAT ('0*** ERROR ALLOCATING WORK FILE -- IER, IERN =',2Z10) 28210000 C 28220000 9994 FORMAT ('0*** ERROR ALLOCATING PLOT FILE -- ERR, ERIN =',2Z10) 28230000 C 28240000 9996 FORMAT ('0*** ERROR UNALLOCATING WORK FILE -- ERR, ERIN =',2Z10) 28250000 C 28260000 9998 FORMAT ('0*** ERROR UNALLOCATING PLOT FILE -- ERR, ERIN =',2Z10) 28270000 C 28300000 END 28310000