CTITLESAFF3DB - BUILD TABLE FOR SYMMETRIC PASS FILTER IN F-X DOMAIN
C***********************************************************************
C                 COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991            *
C***********************************************************************
CABS SAFF3DB - BUILD TABLE FOR SYMMETRIC PASS FILTER IN F-X DOMAIN
C
CSUBROUTINE SAFF3DB
C
C     SUBROUTINE SAFF3DB( H,NXT,NF,DXT,XMX,SCF,
C    *                    DF,F1,F2,F3,F4,V1,V2,CDB,FCT )
C
C     COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991.
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
C
CA    DESIGNER             D CORRIGAN
CA    AUTHOR               D CORRIGAN
CA    LANGUAGE             FORTRAN 77
CA    SYSTEM               IBM/CRAY
CA    WRITTEN              07-12-91
CA
CA    PURPOSE OF PROGRAM:
CA
CA    BUILD TABLE FOR IMPLEMENTATION OF A SYMMETRIC PASS FILTER
CA    IN THE F-X DOMAIN.
CA
C
C***********************************************************************
C
C     SUBROUTINES AND FUNCTIONS CALLED:
C
C     SAFF3DG
C
C***********************************************************************
C
CA
CA    ARGUMENTS:
CA
CA      ARGUMENT      TYPE     I/O   MEANING
CA      --------     -------   ---   --------
CA
CA      H            COMPLEX    O    ARRAY OF FILTERS (NXT,NF)
CA      NXT          INTEGER    I    NUMBER OF OFFSETS PER FREQUENCY
CA      NF           INTEGER    I    NUMBER OF FREQUENCIES
CA      DXT          REAL       O    OFFSET INCREMENT FOR EACH FREQ.
CA      XMX          REAL       O    MAXIMUM OFFSET FOR EACH FREQ.
CA      SCF          REAL       O    SCALAR MULTIPLIER FOR EACH FREQ.
CA      DF           REAL       I    FREQUENCY INCREMENT
CA      F1           REAL       I    LOW  PASS FREQUENCY
CA      F2           REAL       I    LOW  CUT  FREQUENCY
CA      F3           REAL       I    HIGH PASS  FREQUENCY
CA      F4           REAL       I    HIGH CUT FREQUENCY
CA      V1           INTEGER    I    HIGH PASS VELOCITY
CA      V2           INTEGER    I    HIGH CUT  VELOCITY
CA      CDB          INTEGER    I    AMPLITUDE CUTOFF (DB)
CA      FCT          REAL       I    FRACTION OF FX RANGE TO TAPER
CA
CA    EJECT
CAEND
C***********************************************************************
C
C     LOCAL VARIABLES
C
C     DPN  - ABSOLUTE VALUE (P1-P2)                                R*4
C     F    - ACTUAL FREQUENCY BEING CONSIDERED                     R*4
C     FA   - USED IN DETERMINING FREQUENCY SEGMENTS                R*4
C     FXMAX- MAXIMUM FREQ*OFFSET COMPONENT                         R*4
C     HMIN - THIS IS THE ACTUAL CUTOFF AMPLITUDE                   R*4
C     IEF  - ARRAY USED TO HOLD ENDING FREQ. INDEX FOR EACH
C            SEGMENT                                               I*4
C     IF   - LOOP INDEX OVER THE FREQUENCIES                       I*4
C     ISF  - ARRAY USED TO HOLD STARTING FREQ. INDEX FOR EACH
C            SEGMENT                                               I*4
C     NSEG - NUMBER OF FREQUENCY SEGMMENTS TO USE (ONLY 1)         I*4
C     PWR  - LOG TO BASE 10 OF THE CUTOFF AMPLITUDE                R*4
C     P0   - AVERAGE RAY PARAMETER                                 R*4
C     P1   - RAY PARAMETER FOR VELOCITY V1                         R*4
C     P2   - RAY PARAMETER FOR VELOCITY V2                         R*4
C
C***********************************************************************
      SUBROUTINE SAFF3DB( H,NXT,NF,DXT,XMX,SCF,
     *                    DF,F1,F2,F3,F4,V1,V2,CDB,FCT )
C
      IMPLICIT INTEGER (A-Z)
C
      COMPLEX H(NXT,NF)
      REAL DXT(*),XMX(*),SCF(*)
      INTEGER ISF(4),IEF(4)
C
      REAL   AL0,AL1,AL2,AN1,A1,A12,A2,B12,DPN,DF,FCT
      REAL   F,FA,FXMAX,F1,F2,F3,F4,G12I,G12R,HI,HMIN,HR
      REAL   PH3,PI,PWR,P0,P1,P2
      REAL   SCT,SC1,S12,SAFF3DG,X,X1
C
C  ---------------------------------------------------------------------
C
      PI    = 4.0 * ATAN(1.0)
C
      P1    = 1./V1
      P2    = 1./V2
      P0    = .5*(P1+P2)
      DPN   = ABS(P1-P2)
C
C     DETERMINE MAXIMUM FX VALUE
C
      PWR   = -CDB/20.
      HMIN  = 10.**PWR
      PH3   = 16.*PI*ABS(P0)*DPN*DPN*HMIN
      PWR   = -1./3.
      FXMAX = PH3**PWR
C
C  ---------------------------------------------------------------------
C
C     DETERMINE NUMBER OF SEGMENTS IN FREQUENCY AXIS
C
      FA     = F1
      ISF(1) = 1
      NSEG   = 1
      IEF(1) = NF
C
C  --------------------------------------------------------------
C
C     FOR EACH SEGMENT COMPUTE THE TABLE OF FILTERS
C
50    DO 1000 ISEG = 1,NSEG
C
      DO 500 IF = ISF(ISEG),IEF(ISEG)
      F     = F1 + DF*(IF-1)
      AL1   = F/V1
      AL2   = F/V2
      XMX(IF) = FXMAX/F
C
      DXT(IF) = XMX(IF)/(NXT-1)
      SCF(IF) = SAFF3DG( F,F1,F2,F3,F4 )
C
C     NOW COMPUTE ENTRIES IN THE TABLE
C
      AL0      = 2.*PI*( AL1 + AL2 )
      H(1,IF)  = CMPLX(AL0,0.)
C
      DO 200 IX = 2,NXT
      X     = (IX-1)*DXT(IF)
      A1    = 2.*AL1*X
      A2    = 2.*AL2*X
      A12   = A1 - A2
      B12   = 1./(1.-A12*A12)
      S12   = SIN(PI*A1) + SIN(PI*A2)
C
      G12R  = B12*S12/X
      G12I  = 0.
C
      HR    =  G12R
      HI    =  G12I
C
200   H(IX,IF) = CMPLX( HR,HI )
C
C     APPLY TAPER
C
      IF( FCT.GT.0. ) THEN
      X1    = XMX(IF)*FCT/DXT(IF)
      IX1   = X1
      SC1   = PI/FLOAT(NXT-IX1)
C
      DO 300 IX = IX1,NXT
      AN1   = FLOAT(IX-IX1)
      SCT   = .5 + .5*COS(SC1*AN1)
300   H(IX,IF) = SCT*H(IX,IF)
      ENDIF
C
500   CONTINUE
C
1000  CONTINUE
C
C  ---------------------------------------------------------------------
C
      RETURN
      END