*------------- Telecommunications & Signal Processing Lab --------------
*                          McGill University
*
*
* Module:
*     SUBROUTINE FRRESP (X, Y, NPT, H, NCOF, FLTTYP, SFREQ, FUNCT)
*
*
* Purpose:
*     Set frequency response values for a filter
*
*
* Description:
*     This routine sets tye Y-array for a filter frequency response.
*     Initially, the values of the response corresponding to the
*     given frequency values are determined.  Then the extrema of the
*     response values are determined and the frequency values iterated
*     to better correspond to the extrema of the response.
*
*
* Parameters:
* R <-> X      - Abscissa samples.  On return the values corresponding
*                to extrema have been moved if necessary.
* R <-  Y      - Output array of response values
* I ->  NPT    - Number of abscissa and response values
* R ->  H      - Array of filter coefficients
* C ->  FLTTYP - Character string indicating the type of filter,
*                ALL - all-pole filter
*                CAS - cascade analog filter
*                FIR - finite impulse response filter
*                IIR - infinite impulse response filter
*                WIN - window response
* I ->  NCOF   - Number of filter coefficients
* R ->  SFREQ  - Sampling frequency
* F ->  FUNCT  - Name of the function to calculate the frequency
*                response value.  This function name must be declared
*                as EXTERNAL in the calling routine.  This routine is
*                called as
*                val = FUNCT(f,H,NCOF,FLTTYP,SFREQ),
*                where f is a frequency value.
*
*
* Author / revision:
*     P. Kabal
*     $Revision: 1.5 $  $Date: 1995/03/08 15:45:32 $
*
*
*-----------------------------------------------------------------------

      SUBROUTINE FRRESP (X, Y, NPT, H, NCOF, FLTTYP, SFREQ, FUNCT)


      INTEGER MXNEXT
      PARAMETER (MXNEXT=2001)

      CHARACTER*(*) FLTTYP

      INTEGER NPT,NCOF
      INTEGER I,NEXT,IP
      INTEGER IEXT(MXNEXT)

      REAL X(NPT),Y(NPT),H(0:NCOF-1)
      REAL SFREQ
      REAL XL,YL,XU,YU,XM,YM,XT,YT,AD,XDEL

      EXTERNAL FUNCT
      REAL FUNCT


* Fill in the array of frequency response values
      DO 100 I=1,NPT
        Y(I)=FUNCT(X(I),H,NCOF,FLTTYP,SFREQ)
 100  CONTINUE

* Find the extrema of the response values
      CALL LOCEXT (Y, NPT, MXNEXT,IEXT,NEXT)
      IF (NEXT.GT.MXNEXT) CALL HALT('FRRESP - Too many extrema')

* Refine the locations of the extrema
* For functions with many oscillations, the regular grid used to
* calculate the response may cause poor reproduction of the envelope
* of the response.  Here we iterate the frequencies corresponding to
* the local extrema found above to better align the frequency values
* with the true extremal points.  As a result, the maxima and minima of
* the response are better represented in the final plot.
      DO 300 I=1,NEXT
        IP=ABS(IEXT(I))
        IF (IP.NE.1 .AND. IP.NE.NPT) THEN

          XL=X(IP-1)
          YL=Y(IP-1)
          XU=X(IP+1)
          YU=Y(IP+1)
          XM=X(IP)
          YM=Y(IP)
          IF (IEXT(I).GT.0) THEN
            AD=+1.
          ELSE
            AD=-1.
          END IF

* Set the resolution of the refinement to be 10 times the original
* resolution.  This takes between 4 and 8 function evaluations for
* uniformly spaced abscissa values.
          XDEL=0.1*MIN(ABS(XU-XM),ABS(XM-XL))

 200      IF (MIN(ABS(XU-XM),ABS(XM-XL)).GE.XDEL) THEN

* Swap the end points so that YU is closer to the extremum than YL
            IF (AD*(YU-YL).LT.0.0) THEN
              YT=YU
              XT=XU
              YU=YL
              XU=XL
              YL=YT
              XL=XT
            END IF

* Try a step "up"
            XT=XM + 0.5*(XU-XM)
            YT=FUNCT(XT,H,NCOF,FLTTYP,SFREQ)
            IF (AD*(YT-YM).GT.0.0) THEN
              YL=YM
              XL=XM
              YM=YT
              XM=XT
            ELSE
              YU=YT
              XU=XT
              XT=XM - 0.5*(XM-XL)
              YT=FUNCT(XT,H,NCOF,FLTTYP,SFREQ)
              IF (AD*(YT-YM).GT.0.0) THEN
                YU=YM
                XU=XM
                YM=YT
                XM=XT
              ELSE
                YL=YT
                XL=XT
              END IF
            END IF

          GO TO 200
          END IF

          Y(IP)=YM
          X(IP)=XM

        END IF

 300  CONTINUE


      RETURN
      
      END
