CTITLESATCOR -- LAG, WEIGHT, AND CORRELATION OF TRACE AND PILOT 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00000020 CA DESIGNER DANIEL POLAK 00000030 CA LANGUAGE FORTRAN H 00000040 CA SYSTEM S / 370 00000050 CA WRITTEN 10-31-80 00000060 C REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00000070 C REVISED 07-13-81 POLAK - CHANGED THE DIMENSION OF 'CCW' ARRAY00000080 C REVISED 10-05-82 NELAN - ADDED IN COMMON/APSTAT/ FOR AP 00000081 C STATUS AND CHECK FOR RETRY. 00000082 C REVISED 10-24-89 TRULOCK - RESTORE OLD VERSION OF SATCOR. 00000081 CA 00000090 CA CALL SATCOR (TRACES, NSMPLE, FFTLN, LAG, NXCOR, MXNXCR, CIT, 00000100 CA * CITLEN, CCW, CORFN, APFLAG, FCCRLT, SHFT, AMP, DOT) 00000110 CA 00000120 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000130 CA 00000140 CA IN TRACES R4 PILOT TRACE AND 'NXCOR' TRACES FOR 00000150 CA CORRELATION WITH ZEROES ADDED FOR FFT 00000160 CA IN NSMPLE I4 LENGTH OF EACH TRACE WITHOUT ADDED ZEROES 00000170 CA IN FFTLN I4 LENGTH OF FFT 00000180 CA IN LAG I4 NUMBER OF SAMPLES OF LAG TO EXAMINE IN 00000190 CA EACH DIRECTION (ASSUMED TO BE POSITIVE) 00000200 CA IN NXCOR I4 NUMBER OF TRACES TO CORRELATE WITH PILOT 00000210 CA IN MXNXCR I4 MAXIMUM NUMBER OF CORRELATIONS PER CALL 00000220 CA IN CIT R4 WORK AREA FOR CONTROL INFORMATION TABLE 00000230 CA IN CITLEN I4 LENGTH OF CIT 00000240 CA IN CCW R8 WORK AREA FOR CHANNEL COMMAND WORD CHAIN 00000250 CA IN CORFN R4 WORK AREA FOR CORRELATION FUNCTIONS 00000260 CA IN/OUT APFLAG I4 FLAG INDICATING TRANSLATION OF THE AP PROGRAM00000270 CA IN/OUT FCCRLT I4 ADDRESS OF APRL FOR THE AP 3838 TASK 00000280 CA OUT SHFT R4 COMPUTED TIME SHIFTS IN SAMPLES 00000290 CA OUT AMP R4 AMPLITUDE VALUE OF TRACES 00000300 CA OUT DOT R4 DOT PRODUCT OF TRACES AND PILOT FOR OPTIMAL 00000310 CA LAG 00000320 CA 00000330 CA THIS ROUTINE COMPUTES LAGS, AMPLITUDES, AND CORRELATIONS OF 00000340 CA 'NXCOR' INPUT TRACES RELATIVE TO PILOT TRACE. 00000350 CA 00000360 CA 00000370 SUBROUTINE SATCOR (TRACES, NSMPLE, FFTLN, LAG, NXCOR, MXNXCR, CIT,00000380 * CITLEN, CCW, CORFN, APFLAG, FCCRLT, SHFT, AMP, 00000390 * DOT) 00000400 C 00000410 IMPLICIT INTEGER (A-Z) 00000420 EXTERNAL S1ATP 00000430 C 00000440 COMMON /APSTAT/ STATUS 00000450 C 00000451 C REAL ARRAYS IN PARAMETER LIST 00000452 C 00000460 REAL*8 CCW ( 50) 00000470 REAL AMP (MXNXCR) 00000480 REAL CIT (CITLEN) 00000490 REAL CORFN ( 1) 00000500 REAL DOT (MXNXCR) 00000510 REAL SHFT (MXNXCR) 00000520 REAL TRACES ( 1) 00000530 C 00000540 C REAL ARRAY -- LOCAL 00000550 C 00000560 REAL XREG (15) 00000570 C 00000580 C INTEGER ARRAY -- LOCAL 00000590 C 00000600 INTEGER REGS (15) 00000610 C 00000620 EQUIVALENCE (XREG(1), REGS( 1)) 00000630 EQUIVALENCE (TRCNDX , REGS( 1)) 00000640 EQUIVALENCE (FFTNDX , REGS( 2)) 00000650 EQUIVALENCE (AMPNDX , REGS( 3)) 00000660 EQUIVALENCE (FFTLEN , REGS( 4)) 00000670 EQUIVALENCE (LENFFT , REGS( 5)) 00000680 EQUIVALENCE (NSMPL , REGS( 6)) 00000690 EQUIVALENCE (NCOR , REGS( 7)) 00000700 EQUIVALENCE (FACT , REGS( 8)) 00000710 EQUIVALENCE (CORNDX , REGS( 9)) 00000720 EQUIVALENCE (CORLEN , REGS(10)) 00000730 C 00000740 C REAL VARIABLES -- LOCAL 00000750 C 00000760 REAL A 00000770 REAL B 00000780 REAL FACT 00000790 REAL T 00000800 C 00000810 DATA ISTAT /3/ 00000820 DATA ISTATE /0/ 00000830 DATA R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11, R12, 00000840 * R13 00000850 * /1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13/ 00000860 C 00000870 NSMPL = NSMPLE 00000880 FFTLEN = FFTLN + 2 00000890 NCOR = NXCOR 00000900 LL = (NXCOR + 1) * FFTLEN 00000910 C 00000920 C BRANCH IF THE 3838 PROGRAM HAS BEEN BUILT AND TRANSLATED 00000930 C 00000940 IF (APFLAG .NE. 0) GO TO 10 00000950 C 00000960 C GENERATE AND OPEN 3838 PORT 00000970 C 00000980 NOWDS = (MXNXCR + 2) * FFTLEN + CITLEN + MXNXCR 00000990 CALL CSAPUN (NOWDS, APUNIT) 00001000 C 00001010 C BUILD THE 3838 PROGRAM FOR FREQUENCY DOMAIN CORRELATION 00001020 C 00001030 CALL VPSS (APUNIT, 'BLD ', ISTAT, CCW, 50, CIT, CITLEN) 00001040 C 00001050 C TRANSFER REGISTERS AND DATA TO 3838 00001060 C 00001070 CALL VPSS (APUNIT, 'XWR ', REGS, 15, 1) 00001080 NPUT = (MXNXCR + 1) * FFTLEN 00001090 CALL VPSS (APUNIT, 'VPUT', TRACES, NPUT, 0, 0) 00001100 C 00001110 C INITIALIZE WORK REGISTERS 00001120 C 00001130 CALL VPSS (APUNIT, 'XMV ', R11, R4) 00001140 CALL VPSS (APUNIT, 'XSB ', R11, R10) 00001150 CALL VPSS (APUNIT, 'XMV ', R13, R7) 00001160 C 00001170 C EXECUTE FFT ON THE PILOT TRACE 00001180 C 00001190 CALL VPSS (APUNIT, 'FFTR', ISTATE, 00001200 * 96, 0, 0, R2, R5, 00001210 * 64, 0, -2, R4) 00001220 C 00001230 CALL VPSS (APUNIT, 'VMV ', ISTATE, 00001240 * 64, 0, 0, 1, R4, 00001250 * 32, 0, 1, R2) 00001260 C 00001270 C TOP OF LOOP FOR CORRELATION OF 'MXNXCR' TRACES 00001280 C 00001290 CALL VPSS (APUNIT, 'XID ', 'LOOP') 00001300 C 00001310 C UPDATE INDICES 00001320 C 00001330 CALL VPSS (APUNIT, 'XAD ', R1, R4) 00001340 CALL VPSS (APUNIT, 'XADI', R3, 1) 00001350 C 00001360 C COMPUTE THE SUM OF THE SQUARES OF THE GATHER TRACE ELEMENTS 00001370 C 00001380 CALL VPSS (APUNIT, 'SSQ ', ISTATE, 00001390 * 32, 0, R3, 00001400 * 96, 0, 0, 1, R1, R4) 00001410 C 00001420 C REVERSE THE GATHER TRACE FOR CORRELATION 00001430 C 00001440 CALL VPSS (APUNIT, 'REV ', ISTATE, 00001450 * 96, 0, 0, 1, R1, R6, 00001460 * 32, 0, 1, R1) 00001470 C 00001480 C EXECUTE FFT ON THE GATHER TRACE 00001490 C 00001500 CALL VPSS (APUNIT, 'FFTR', ISTATE, 00001510 * 96, 0, 0, R2, R5, 00001520 * 96, 0, -2, R1, R4) 00001530 C 00001540 C MULTIPLY FFT OUTPUTS (COMPLEX MULTIPLY WITH CONJUGATE OUTPUT) 00001550 C 00001560 CALL VPSS (APUNIT, 'CMCO', ISTATE, 00001570 * 96, 0, 0, R2, R5, 00001580 * 32, 0, R2, 00001590 * 0, 0) 00001600 C 00001610 C EXECUTE AN INVERSE FFT ON THE CONJUGATE PRODUCT 00001620 C 00001630 CALL VPSS (APUNIT, 'IFTR', ISTATE, 00001640 * 96, 0, -2, R1, R4, 00001650 * 96, 0, 0, R2, R5) 00001660 C 00001670 C NORMALIZE THE OUTPUT 00001680 C 00001690 CALL VPSS (APUNIT, 'XMVX', 0, 1, R2, R8) 00001700 C 00001710 CALL VPSS (APUNIT, 'SMY ', ISTATE, 00001720 * 96, 0, 0, 1, R1, R4, 00001730 * 32, 0, 1, R1, 00001740 * 32, 0, R2) 00001750 C 00001760 C MOVE CORRELATION FUNCTION FOR COMPRESSED RETURN OF ALL 00001770 C CORRELATION FUNCTIONS 00001780 C 00001790 CALL VPSS (APUNIT, 'XAD ', R11, R10) 00001800 CALL VPSS (APUNIT, 'XMV ', R12, R1) 00001810 CALL VPSS (APUNIT, 'XAD ', R12, R9) 00001820 C 00001830 CALL VPSS (APUNIT, 'VMV ', ISTATE, 00001840 * 96, 0, 0, 1, R11, R10, 00001850 * 32, 0, 1, R12) 00001860 C 00001870 C HAS 'NXCOR' TRACES BEEN CORRELATED? 00001880 C 00001890 CALL VPSS (APUNIT, 'XDCI', R7, 0, 'LOOP', 'GT ') 00001900 C 00001910 C GET RESULTS BACK TO 370 00001920 C 00001930 NGET = MXNXCR * (2 * LAG + 1) 00001940 CALL VPSS (APUNIT, 'VGET', CORFN, NGET, 0, R4) 00001950 CALL VPSS (APUNIT, 'XSB ', R3, R13) 00001960 CALL VPSS (APUNIT, 'XADI', R3, 1) 00001970 C 00001980 CALL VPSS (APUNIT, 'SQRT', ISTATE, 00001990 * 64, 0, 0, 1, R13, 00002000 * 32, 0, 1, R3) 00002010 CALL VPSS (APUNIT, 'VGET', AMP, MXNXCR, 0, 0) 00002020 C 00002030 C TRANSLATE THE 3838 PROGRAM 00002040 C 00002050 CALL VPSS (APUNIT, 'XLTE', FCCRLT) 00002060 C 00002070 APFLAG = 1 00002080 C 00002090 C INITIALIZE 00002100 C 00002110 10 DO 20 I = 1, MXNXCR 00002120 AMP(I) = 0. 00002130 DOT(I) = 0. 00002140 20 SHFT(I) = 0. 00002150 C 00002160 C CALCULATE INDICES AND LENGTHS FOR THE 3838 INDEX REGISTERS 00002170 C 00002180 TRCNDX = 0 00002190 FFTNDX = (NXCOR + 1) * FFTLEN 00002200 LENFFT = FFTLEN / 2 00002210 AMPNDX = (NXCOR + 2) * FFTLEN 00002220 FACT = 1.0 / (4.0 * FFTLN) 00002230 CORNDX = NSMPL - 1 00002240 CORLEN = 2 * LAG + 1 00002250 C 00002260 C CORRELATE TRACES WITH PILOT BY EXECUTING THE 3838 PROGRAM 00002270 C 00002280 25 STATUS = 0 00002281 CALL VPSS (APUNIT, 'EXCW', FCCRLT) 00002290 IF (STATUS .LT. 0) GO TO 25 00002291 C 00002300 C DETERMINE THE OPTIMAL RELATIVE LAGS 00002310 C 00002320 DO 50 I = 1, NXCOR 00002330 BEG = (I - 1) * CORLEN + 1 00002340 END = BEG + CORLEN - 1 00002350 C 00002360 C LOCATE MAX CORRELATION SAMPLE 00002370 C 00002380 DO 30 J = BEG, END 00002390 IF (CORFN(J) .LT. DOT(I)) GO TO 30 00002400 JJ = J 00002410 DOT (I) = CORFN(J) 00002420 C 00002430 30 CONTINUE 00002440 C 00002450 C IF CORRELATION NOT ZERO PERFORM QUADRATIC INTERPOLATION AROUND 00002460 C PEAK SAMPLE TO OBTAIN PEAK CORRELATION AND TIME SHIFT. 00002470 C 00002480 II = JJ - BEG + 1 00002490 IF (DOT(I) .EQ. 0.) GO TO 50 00002500 SHFT(I) = II - LAG - 1 00002510 IF (II .EQ. 1 .OR. II .EQ. CORLEN) GO TO 40 00002520 A = .5 * (CORFN(JJ+1) - 2. * DOT(I) + CORFN(JJ-1)) 00002530 IF (A .EQ. 0.) GO TO 50 00002540 B = .5 * (CORFN(JJ+1) - CORFN(JJ-1)) 00002550 T = -.5 * B / A 00002560 DOT(I) = (A * T + B) * T + DOT(I) 00002570 SHFT(I) = SHFT(I) + T 00002580 GO TO 50 00002590 C 00002600 40 DOT(I) = 0. 00002610 C 00002620 50 CONTINUE 00002630 RETURN 00002640 END 00002650