CTITLESAFF2DB - APPLY 2D FAN FILTER 00010006 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CABS SAFF2DB - APPLY 2D FAN FILTER 00020006 C 00030006 CSUBROUTINE SAFF2DB 00040006 C 00050006 C SUBROUTINE SAFF2DB( D,NF,NX,LF,F,ISIGN,E,RD,RF,RE ) 00060006 C 00070006 C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1992. 00080006 C 00090006 C ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, 00100006 C REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE00110006 C PRIOR CONSENT OF ATLANTIC RICHFIELD COMPANY. 00120006 C 00130006 CA 00140006 CA DESIGNER D CORRIGAN 00150006 CA AUTHOR D CORRIGAN 00160006 CA LANGUAGE FORTRAN 77 00170006 CA SYSTEM IBM (SEE CRAY) 00180006 CA WRITTEN 08-20-92 00190006 CA 00200006 CA 00210006 CA PURPOSE OF PROGRAM: 00220006 CA 00230006 CA TO APPLY FAN FILTERS FOR ALL FREQUENCIES 00240006 CA 00250006 C************************************************************** 00260006 C * 00270006 C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE * 00280006 C * 00290006 C CCOPY SNAXPY * 00300006 C * 00310006 C************************************************************** 00320006 C 00330006 CA 00340006 CA ARGUMENTS: 00350006 CA 00360006 CA ARGUMENT TYPE I/O MEANING 00370006 CA -------- ------- --- -------- 00380006 CA 00390006 CA D COMPLEX I DATA TO BE FILTERED (NF,NX) 00400006 CA NF INTEGER I NUMBER OF FREQUENCIES 00410006 CA NX INTEGER I NUMBER OF OFFSETS 00420006 CA LF INTEGER I FILTER LENGTHS FOR EACH FREQUENCY 00430006 CA F COMPLEX I FILTERS FOR EACH FREQUENCY 00440006 CA ISIGN INTEGER I OFFSETS INCREASING (ISIGN=+1) 00450006 CA OFFSETS DECREASING (ISIGN=-1) 00460006 CA E COMPLEX O FILTERED DATA 00470006 CA RD REAL I WORK ARRAY FOR DATA 00480006 CA RF REAL I WORK ARRAY FOR FILTER 00490006 CA RE REAL I WORK ARRAY FOR OUTPUT 00500006 CA 00510006 CA 00520006 CA EJECT 00530006 CAEND 00540006 C***********************************************************************00550006 C 00560006 C LOCAL VARIABLES 00570006 C 00580006 C IF - LOOP INDEX OVER RADIAL FREQUENCY I*4 00590006 C II - IMAGINARY INDEX POINTER 00600006 C IR - REAL INDEX POINTER 00610006 C IRD - INDEX IN DATA WORK ARRAY 00620006 C IXF - INDEX IN OUTPUT FILTER ARRAY I*4 00630006 C LFH - HALF FILTER LENGTH ( LF = 2*LFH +1 ) I*4 00640006 C LFT - FILTER LENGTH FOR FREQUENCY IF I*4 00650006 C 00660006 C***********************************************************************00670006 C 00680006 SUBROUTINE SAFF2DB( D,NF,NX,LF,F,ISIGN,E,RD,RF,RE ) 00690006 C 00700006 IMPLICIT INTEGER (A-Z) 00710006 C 00720006 COMPLEX D(NF,*) 00730006 COMPLEX F(*) 00740006 COMPLEX E(NF,*) 00750006 COMPLEX ZERO 00760006 C 00770006 REAL RD(*),RF(*),RE(*) 00780006 C 00790006 INTEGER LF(*) 00800006 C 00810006 DATA ZERO / (0.,0.) / 00820006 C 00830006 C ---------------------------------------------------------------------00840006 C 00850006 C FOR EACH FREQUENCY, DETERMINE FILTER LENGTH 00860006 C AND BUILD FILTERS USING INPUT TABLE 00870006 C 00880006 IXF = 1 00890006 IR = 1 00900006 II = 2 00910006 IF( ISIGN.GT.0 ) THEN 00920006 ISD = 1 00930006 ELSE 00940006 ISD = -1 00950006 ENDIF 00960006 C 00970006 DO 500 IF = 1,NF 00980006 C 00990006 C MOVE DATA TO REAL WORK AREA 01000006 C 01010006 LFT = LF(IF) 01020006 LFH = LFT/2 01030006 IRD = 1 01040006 CALL CCOPY( LFH,ZERO,0,RD(IRD),1 ) 01050006 IRD = IRD + 2*LFH 01060006 CALL CCOPY( NX,D(IF,1),NF,RD(IRD),ISD ) 01070006 IRD = IRD + 2*NX 01080006 CALL CCOPY( LFH,ZERO,0,RD(IRD),1 ) 01090006 C 01100006 C MOVE FILTER TO REAL WORK AREA 01110006 C 01120006 CALL CCOPY( LFT,F(IXF),1,RF,1 ) 01130006 C 01140006 C ZERO OUTPUT REAL WORK AREA 01150006 C 01160006 CALL CCOPY( NX,ZERO,0,RE,1 ) 01170006 C 01180006 C FILTER 01190006 C 01200006 CALL SNAXPY( LFT,NX,RF(IR),2,RD(II),2,2,RE(II),2,0 ) 01210006 CALL SNAXPY( LFT,NX,RF(II),2,RD(IR),2,2,RE(II),2,0 ) 01220006 CALL SNAXPY( LFT,NX,RF(IR),2,RD(IR),2,2,RE(IR),2,0 ) 01230006 C 01240006 DO 100 JJ = II,2*LFT,2 01250006 RF(JJ) = -RF(JJ) 01260006 100 CONTINUE 01270006 C 01280006 CALL SNAXPY( LFT,NX,RF(II),2,RD(II),2,2,RE(IR),2,0 ) 01290006 C 01300006 C MOVE OUTPUT INTO E 01310006 C 01320006 CALL CCOPY( NX,RE,ISD,E(IF,1),NF ) 01330006 IXF = IXF + LFT 01340006 C 01350006 500 CONTINUE 01360006 C 01370006 C ---------------------------------------------------------------------01380006 C 01390006 RETURN 01400006 END 01410006