CTITLESAFF3DE - APPLY FAN FILTER WITHOUT PHASE DISTORTION CORRECTION
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CABS  SAFF3DE - APPLY FAN FILTER WITHOUT PHASE DISTORTION CORRECTION
C
CSUBROUTINE SAFF3DE
C
C     SUBROUTINE SAFF3DE( D,H,NXT,NF,DXT,XMX,SCF,
C    *                    NTIN,IOUT,ITN,DX,B,C,A )
C
C     COPYRIGHT ATLANTIC RICHFIELD COMPANY 1992.
C
C     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,
C     REPRODUCED, OR  TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE
C     PRIOR CONSENT OF ATLANTIC RICHFIELD COMPANY.
C
CA
CA    DESIGNER             D CORRIGAN
CA    AUTHOR               D CORRIGAN
CA    LANGUAGE             FORTRAN 77
CA    SYSTEM               IBM/CRAY
CA    WRITTEN              03-20-91
CA
CA    PURPOSE OF PROGRAM:
CA
CA    TO APPLY THE FAN FILTER IN THE F-X DOMAIN WITHOUT A
CA    PHASE DISTORTION CORRECTION.
CA
C**************************************************************
C                                                             *
C SUBROUTINES AND FUNCTIONS CALLED FROM THIS ROUTINE          *
C                                                             *
C CCOPY   CDOTC     CDOTU                                     *
C                                                             *
C**************************************************************
C
CA
CA    ARGUMENTS:
CA
CA      ARGUMENT      TYPE     I/O   MEANING
CA      --------     -------   ---   --------
CA
CA      D            COMPLEX    I    INPUT DATA    (NF,1)
CA      H            COMPLEX    I    TABLE OF FILTERS (NTX,NF)
CA      NTX          INTEGER    I    NUMBER OF OFFSETS PER FREQUENCY
CA      NF           INTEGER    I    NUMBER OF FREQUENCIES
CA      DXT          REAL       I    OFFSET INCREMENTS FOR EACH FREQ.
CA      XMX          REAL       I    MAXIMUM OFFSET FOR EACH FREQ.
CA      SCF          REAL       I    SCALAR MULTIPLIER FOR EACH FREQ.
CA      NTIN         INTEGER    I    NUMBER OF TRACES FOR THIS OUTPUT
CA      IOUT         INTEGER    I    TRACE NUMBER FOR THIS OUTPUT
CA      ITN          INTEGER    I    ARRAY OF INPUT TRACE NUMBERS
CA      DX           REAL       I    ARRAY OF DIFFERENTIAL OFFSETS
CA      B            COMPLEX    I    ARRAY 1 FOR SCALAR PRODUCT
CA      C            COMPLEX    I    ARRAY 2 FOR SCALAR PRODUCT
CA      A            COMPLEX    O    NOISE ESTIMATE FOR THIS TRACE (NF)
CA
CA
CA    EJECT
CAEND
C***********************************************************************
C
C     LOCAL VARIABLES
C
C     BB  -  ACCUMULATION VARIABLE USED TO OBTAIN NOISE ESTIMATE   R*4
C     DXMAX -MAXIMUM FREQUENCY*OFFSET/FREQUENCY VALUE              R*4
C     FDX -  FRACTIONAL PART OF SCALED VALUE                       R*4
C     IF  -  LOOP INDEX OVER RADIAL FREQUENCY                      I*4
C     IXH -  INTEGER PART OF SCALED VALUE                          I*4
C     I1  -  USE TO DETERMINE APERATURE TRACES IF DIFFERENTIAL OFFSET
C            FOR I1 >= DXMAX                                       I*4
C     I2  -  USE TO DETERMINE APERATURE TRACES IF DIFFERENTIAL OFFSET
C            FOR I2 <= DXMAX                                       I*4
C     N2D -  NUMBER OF TRACES IN APERTURE                          I*4
C     SCX -  SCALING FACTOR BASED ON OFFSET AND FREQUENCY          R*4
C     XIH -  REAL PART OF SCALED VALUE                             R*4
C
C***********************************************************************
C
      SUBROUTINE SAFF3DE( D,H,NXT,NF,DXT,XMX,SCF,
     *                    NTIN,IOUT,ITN,DX,B,C,A )
C
      IMPLICIT INTEGER (A-Z)
C
      COMPLEX D(NF,*),A(*)
      COMPLEX H(NXT,NF)
      COMPLEX B(*),C(NF,*)
      COMPLEX ZERO
      COMPLEX CDOTC,CDOTU
      REAL    DX(*)
      REAL    DXT(*),XMX(*)
      REAL    SCF(*)
      INTEGER ITN(*)
C
      REAL   DXMAX,BB,FDX,SCX,XIH
C
      DATA ZERO /(0.,0.)/
C
C  ---------------------------------------------------------------------
C
C         INITIALIZE MIN AND MAX TRACES
C         CONTRIBUTING TO FIRST FREQUENCY
C
      I1  = 1
      I2  = NTIN
      IX  = IOUT
C
C        STORE INPUT DATA IN C
C
      DO 50  I = 1,NTIN
50    CALL CCOPY( NF,D(1,ITN(I)),1,C(1,I),1 )
C
C        FOR EACH FREQUENCY:
C
C           1. DETERMINE CONTRIBUTING TRACES
C           2. GET APPROPRIATE FILTER WEIGHTS
C           3. APPLY WEIGHTS
C
      DO 800 IF = 1,NF
      DXMAX = XMX(IF)
C
C      DETERMINE APERTURE
C
100   IF( I1.GE.IX ) GO TO 200
      IF( -DX(I1).LE.DXMAX ) GO TO 200
      I1  = I1 + 1
      GO TO 100
200   IF( I2.LE.IX ) GO TO 500
      IF( DX(I2).LE.DXMAX ) GO TO 500
      I2  = I2 - 1
      GO TO 200
C
C       FOR EACH TRACE IN THE APERTURE, GET WEIGHTS AND APPLY
C
500   BB    = 0.
      SCX   = 1./DXT(IF)
      DO 600 I = I1,IX
      XIH   = -DX(I)*SCX + 1.
      IXH   = XIH
      FDX   = XIH - IXH
600   B(I)  = H(IXH,IF) + FDX*(H(IXH+1,IF)-H(IXH,IF))
C
      DO 700 I = IX+1,I2
      XIH   = +DX(I)*SCX + 1.
      IXH   = XIH
      FDX   = XIH - IXH
700   B(I)  = CONJG(H(IXH,IF)) + FDX*CONJG(H(IXH+1,IF)-H(IXH,IF))
C
      N2D   = I2 - I1 + 1
      BB    = CDOTC( N2D,B(I1),1,B(I1),1 )
      A(IF) = SCF(IF)*CDOTU( N2D,B(I1),1,C(IF,I1),NF )
      A(IF) = H(1,IF)*A(IF)/BB
C
800   CONTINUE
C
C  ---------------------------------------------------------------------
C
      RETURN
      END