CTITLESAFF2DA - BUILD 2D FAN FILTERS FROM TABLE 00010003 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CABS SAFF2DA - BUILD 2D FAN FILTERS FROM TABLE 00020003 C 00030003 CSUBROUTINE SAFF2DA 00040003 C 00050003 C SUBROUTINE SAFF2DA( H,NXT,NF,DXT,XMX,SCF,DXI,NTRC, 00060003 C * LFBUF,LFMAX,LF,F,B ) 00070003 C 00080003 C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1992. 00090003 C 00100003 C ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, 00110003 C REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE00120003 C PRIOR CONSENT OF ATLANTIC RICHFIELD COMPANY. 00130003 C 00140003 CA 00150003 CA DESIGNER D CORRIGAN 00160003 CA AUTHOR D CORRIGAN 00170003 CA LANGUAGE FORTRAN 77 00180003 CA SYSTEM IBM/CRAY 00190003 CA WRITTEN 08-20-92 00200003 CA 00210003 CA 00220003 CA PURPOSE OF PROGRAM: 00230003 CA 00240003 CA TO BUILD FAN FILTERS FOR EACH FREQUENCY 00250003 CA 00260003 C************************************************************** 00270003 C * 00280003 C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE * 00290003 C * 00300003 C NONE * 00310003 C * 00320003 C************************************************************** 00330003 C 00340003 CA 00350003 CA ARGUMENTS: 00360003 CA 00370003 CA ARGUMENT TYPE I/O MEANING 00380003 CA -------- ------- --- -------- 00390003 CA 00400003 CA H COMPLEX I TABLE OF FILTERS (NTX,NF) 00410003 CA NTX INTEGER I NUMBER OF OFFSETS PER FREQUENCY 00420003 CA NF INTEGER I NUMBER OF FREQUENCIES 00430003 CA DXT REAL I OFFSET INCREMENTS FOR EACH FREQ. 00440003 CA XMX REAL I MAXIMUM OFFSET FOR EACH FREQ. 00450003 CA SCF REAL I SCALAR MULTIPLIER FOR EACH FREQ. 00460003 CA DXI REAL I GROUP INTERVAL 00470003 CA NTRC INTEGER I MAXIMUM NUMBER OF TRACES IN GATHER 00480003 CA LFBUF INTEGER O LENGTH OF FILTER BUFFER 00490003 CA (COMPLEX WORDS) 00500003 CA LFMAX INTEGER O MAXIMUM FILTER LENGTH 00510003 CA LF INTEGER O FILTER LENGTHS FOR EACH FREQUENCY 00520003 CA F COMPLEX O FILTERS FOR EACH FREQUENCY 00530003 CA B COMPLEX I WORK ARRAY 00540003 CA 00550003 CA 00560003 CA EJECT 00570003 CAEND 00580003 C***********************************************************************00590003 C 00600003 C LOCAL VARIABLES 00610003 C 00620003 C BB - ACCUMULATION VARIABLE USED TO OBTAIN NOISE ESTIMATE R*4 00630003 C DXC - OFFSET VARYING WITH FILTER LAG R*4 00640003 C FDX - FRACTIONAL PART OF SCALED VALUE R*4 00650003 C IF - LOOP INDEX OVER RADIAL FREQUENCY I*4 00660003 C IXF - INDEX IN OUTPUT FILTER ARRAY I*4 00670003 C IXH - INTEGER PART OF SCALED VALUE I*4 00680003 C LFH - HALF FILTER LENGTH ( LF = 2*LFH +1 ) I*4 00690003 C SCX - SCALING FACTOR BASED ON OFFSET AND FREQUENCY R*4 00700003 C XIH - REAL PART OF SCALED VALUE R*4 00710003 C 00720003 C***********************************************************************00730003 C 00740003 SUBROUTINE SAFF2DA( H,NXT,NF,DXT,XMX,SCF,NTRC,DXI, 00750003 * LFBUF,LFMAX,LF,F,B ) 00760003 C 00770003 IMPLICIT INTEGER (A-Z) 00780003 C 00790003 COMPLEX H(NXT,NF) 00800003 COMPLEX F(*) 00810003 COMPLEX B(*) 00820003 COMPLEX ZSC 00830003 C 00840003 REAL DXT(*),XMX(*) 00850003 REAL SCF(*) 00860003 REAL DXI,DXC 00870003 REAL BB,FDX,SCX,XIH 00880003 C 00890003 INTEGER LF(*) 00900003 C 00910003 C ---------------------------------------------------------------------00920003 C 00930003 C FOR EACH FREQUENCY, DETERMINE FILTER LENGTH 00940003 C AND BUILD FILTERS USING INPUT TABLE 00950003 C 00960003 IXF = 1 00970003 LFBUF = 0 00980003 LFMAX = 0 00990003 DO 500 IF = 1,NF 01000003 C 01010003 C DETERMINE LENGTH 01020003 C 01030003 LFH = XMX(IF)/DXI 01040003 LFH = MIN0( LFH,NTRC-1 ) 01050003 DXC = DXI*LFH 01060003 LF(IF) = 2*LFH + 1 01070003 LFBUF = LFBUF + LF(IF) 01080003 LFMAX = MAX0( LFMAX,LF(IF) ) 01090003 C 01100003 C BUILD FILTER 01110003 C 01120003 B(LFH+1) = H(1,IF) 01130003 BB = B(LFH+1)*B(LFH+1) 01140003 SCX = 1./DXT(IF) 01150003 J = LF(IF) 01160003 DO 200 I = 1,LFH 01170003 XIH = DXC*SCX + 1. 01180003 IXH = XIH 01190003 FDX = XIH - IXH 01200003 B(I) = H(IXH,IF) + FDX*(H(IXH+1,IF)-H(IXH,IF)) 01210003 B(J) = CONJG(B(I)) 01220003 BB = BB + 2.*B(I)*B(J) 01230003 DXC = DXC - DXI 01240003 J = J - 1 01250003 200 CONTINUE 01260003 C 01270003 C SCALE AND STORE IN F(IXF) 01280003 C 01290003 ZSC = SCF(IF)*H(1,IF)/BB 01300003 DO 400 I = 1,LF(IF) 01310003 F(IXF) = ZSC*B(I) 01320003 IXF = IXF + 1 01330003 400 CONTINUE 01340003 C 01350003 500 CONTINUE 01360003 C 01370003 C ---------------------------------------------------------------------01380003 C 01390003 RETURN 01400003 END 01410003