      SUBROUTINE OPTMCCPA(NFILT,JTYPE,NBANDS,LPRINT,LGRID,
     X              EDGE,FX,WTX,DEVIAT, h )
C
C      PROGRAM FOR THE DESIGN OF LINEAR PHASE FINITE IMPULSE
C      REPONSE (FIR) FILTERS USING THE REMEZ EXCHANGE ALGORITHM
C
c************************************************************
C*  Reference: McClellan, J.H., T.W. Parks and L.R.Rabiner, *
C*             1973: " A computer program for designing     *
C*             optimum FIR linear phase digital filters.    *
C*             IEEE Trans. on Audio and Electroacoustics,   *
C*             Vol AU-21, No. 6, 506-526.                   *
c************************************************************
C
C      THREE TYPES OF FILTERS ARE INCLUDED -- BANDPASS FILTERS
C      DIFFERENTIATORS, AND HILBERT TRANSFORM FILTERS
C
C---------------------------------------------------------------
C
      COMMON /x3x/ PI2,AD,DEV,X,Y,GRID,DES,WT,ALPHA,IEXT,NFCNS,NGRID
      DIMENSION IEXT(181),AD(181),ALPHA(181),X(181),Y(181)
      DIMENSION H(181)
      DIMENSION DES(1045),GRID(1045),WT(1045)
      DIMENSION EDGE(20),FX(10),WTX(10),DEVIAT(10)
      DOUBLE PRECISION PI2,PI
      DOUBLE PRECISION AD,DEV,X,Y
      LOGICAL LPRINT

      PI  = 3.141592653589793
      PI2 = 6.283185307179586

C      ......

      NFMAX = 128
100      CONTINUE

C      PROGRAM INPUT SECTION

CCC     READ(5,*) NFILT,JTYPE,NBANDS,JPRINT,LGRID

      IF(NFILT.GT.NFMAX.OR.NFILT.LT.3) CALL OPTERROR
      IF(NBANDS.LE.0) NBANDS = 1

C      ....

      IF(LGRID.LE.0) LGRID = 16
      JB = 2*NBANDS
ccc       READ(5,*) (EDGE(J),J=1,JB)
ccc       READ(5,*) (FX(J),J=1,NBANDS)
ccc       READ(5,*) (WTX(J),J=1,NBANDS)
      IF(JTYPE.EQ.0) CALL OPTERROR
      NEG = 1
      IF(JTYPE.EQ.1) NEG = 0
      NODD = NFILT/2
      NODD = NFILT-2*NODD
      NFCNS = NFILT/2
      IF(NODD.EQ.1.AND.NEG.EQ.0) NFCNS = NFCNS+1

C      ...

      GRID(1) = EDGE(1)
      DELF = LGRID*NFCNS
      DELF = 0.5/DELF
      IF(NEG.EQ.0) GOTO 135
      IF(EDGE(1).LT.DELF) GRID(1) = DELF
135      CONTINUE
      J = 1
      L = 1
      LBAND = 1
140      FUP = EDGE(L+1)
145      TEMP = GRID(J)

C      ....

      DES(J) = OPTEFF(TEMP,FX,WTX,LBAND,JTYPE)
      WT(J) = OPTWATE(TEMP,FX,WTX,LBAND,JTYPE)
      J = J+1
      GRID(J) = TEMP+DELF
      IF(GRID(J).GT.FUP) GOTO 150
      GOTO 145
150      GRID(J-1) = FUP
      DES(J-1) = OPTEFF(FUP,FX,WTX,LBAND,JTYPE)
      WT(J-1) = OPTWATE(FUP,FX,WTX,LBAND,JTYPE)
      LBAND = LBAND+1
      L = L+2
      IF(LBAND.GT.NBANDS) GOTO 160
      GRID(J) = EDGE(L)
      GOTO 140
160      NGRID = J-1
      IF(NEG.NE.NODD) GOTO 165
      IF(GRID(NGRID).GT.(0.5-DELF)) NGRID = NGRID-1
165      CONTINUE

C      ......

      IF(NEG) 170,170,180
170      IF(NODD.EQ.1) GOTO 200
      DO 175 J=1,NGRID
            CHANGE = DCOS(PI*GRID(J))
            DES(J) = DES(J)/CHANGE
            WT(J) = WT(J)*CHANGE
175      CONTINUE
      GOTO 200
180      IF(NODD.EQ.1) GOTO 190
      DO 185 J = 1,NGRID
            CHANGE = DSIN(PI*GRID(J))
            DES(J) = DES(J)/CHANGE
            WT(J)  = WT(J)*CHANGE
185      CONTINUE
      GOTO 200
190      DO 195 J =1,NGRID
            CHANGE = DSIN(PI2*GRID(J))
            DES(J) = DES(J)/CHANGE
            WT(J)  = WT(J)*CHANGE
195      CONTINUE

C      ......

200      TEMP = FLOAT(NGRID-1)/FLOAT(NFCNS)
      DO 210 J = 1,NFCNS
            IEXT(J) = (J-1)*TEMP+1
210      CONTINUE
      IEXT(NFCNS+1) = NGRID
      NM1 = NFCNS-1
      NZ  = NFCNS+1

C CALL THE REMEZ EXCHANGE ALGORITHM TO DO THE APPROXIMATION PROBLEM

      CALL OPTREMEZ(EDGE,NBANDS)

C CALCULATE THE IMPULSE RESPONSE

      IF(NEG) 300,300,320
300      IF(NODD.EQ.0) GOTO 310
      DO 305 J=1,NM1
            H(J) = 0.5*ALPHA(NZ-J)
305      CONTINUE
      H(NFCNS)=ALPHA(1)
      GOTO 350
310      H(1) = 0.25*ALPHA(NFCNS)
      DO 315 J = 2,NM1
            H(J) = 0.25*(ALPHA(NZ-J)+ALPHA(NFCNS+2-J))
315      CONTINUE
      H(NFCNS) = 0.5*ALPHA(1)+0.25*ALPHA(2)
      GOTO 350
320      IF(NODD.EQ.0) GOTO 330
      H(1) = 0.25*ALPHA(NFCNS)
      H(2) = 0.25*ALPHA(NM1)
      DO 325 J = 3,NM1
            H(J) = 0.25*(ALPHA(NZ-J)-ALPHA(NFCNS+3-J))
325      CONTINUE
      H(NFCNS) = 0.5*ALPHA(1)-0.25*ALPHA(3)
      H(NZ) = 0.0
      GOTO 350
330      H(1) = 0.25*ALPHA(NFCNS)
      DO 335 J =2,NM1
            H(J) = 0.25*(ALPHA(NZ-J)-ALPHA(NFCNS+2-J))
335      CONTINUE
      H(NFCNS) = 0.5*ALPHA(1)-0.25*ALPHA(2)

C   PROGRAM OUTPUT SECTION

350   CONTINUE
c
      IF(LPRINT) THEN

         WRITE(6,360)
360      FORMAT(1H1,70(1H*)//25X,'FINITE IMPULSE RESPONSE (FIR)'/
     1  25X,'LINEAR PHASE DIGITAL FILTER DESIGN'/
     2  25X,'REMEZ EXCHANGE ALGORITHM'/)

      IF(JTYPE.EQ.1) WRITE(6,365)
365      FORMAT(25X,'BANDPASS FILTER'/)

      IF(JTYPE.EQ.2) WRITE(6,370)
370      FORMAT(25X,'DIFFERENTIATOR '/)

      IF(JTYPE.EQ.3) WRITE(6,375)
375      FORMAT(25X,'HILBERT TRANSFORMER '/)

      WRITE(6,378) NFILT
378      FORMAT(15X,'FILTER LENGTH =',I3/)

      WRITE(6,380)
380      FORMAT(15X,'***** IMPULSE RESPONSE *****')

      DO 381 J = 1,NFCNS
            K = NFILT+1-J
            IF(NEG.EQ.0) WRITE(6,382) J,H(J),K
            IF(NEG.EQ.1) WRITE(6,383) J,H(J),K
381      CONTINUE
382      FORMAT(20X,'H(',I3,') = ',E15.8,' = H(',I4,')')
383      FORMAT(20X,'H(',I3,') = ',E15.8,' = -H(',I4,')')

      IF(NEG.EQ.1.AND.NODD.EQ.1) WRITE(6,384) NZ
384      FORMAT(20X,'H(',I3,') = 0.0')

      DO 450 K=1,NBANDS,4
            KUP = K+3
            IF(KUP.GT.NBANDS) KUP = NBANDS
            WRITE(6,385) (J,J=K,KUP)
385            FORMAT(/24X,4('BAND',I3,8X))
            WRITE(6,390) (EDGE(2*J-1),J=K,KUP)
390            FORMAT(2X,'LOWER BAND EDGE',5F15.8)
            WRITE(6,395) (EDGE(2*J),J=K,KUP)
395            FORMAT(2X,'UPPER BAND EDGE',5F15.8)
            IF(JTYPE.NE.2) WRITE(6,400) (FX(J),J=K,KUP)
400            FORMAT(2X,'DESIRED VALUE',2X,5F15.8)
            IF(JTYPE.EQ.2) WRITE(6,405) (FX(J),J=K,KUP)
405            FORMAT(2X,'DESIRED SLOPE',2X,5F15.8)
            WRITE(6,410) (WTX(J),J=K,KUP)
410            FORMAT(2X,'WEIGHTING',6X,5F15.8)
            DO 420 J = K,KUP
                  DEVIAT(J) = DEV/WTX(J)
420            CONTINUE
            WRITE(6,425) (DEVIAT(J),J=K,KUP)
425            FORMAT(2X,'DEVIATION',6X,5F15.8)
            IF(JTYPE.NE.1) GOTO 450
            DO 430 J = K,KUP
                  DEVIAT(J) = 20.0*ALOG10(DEVIAT(J))
430            CONTINUE
            WRITE(6,435) (DEVIAT(J),J=K,KUP)
435            FORMAT(2X,'DEVIATION IN DB',5F15.8)
450      CONTINUE
      WRITE(6,455) (GRID(IEXT(J)),J=1,NZ)
455      FORMAT(/2X,'EXTREMAL FREQUENCIES'/(2X,5F15.7))
      WRITE(6,460)
460      FORMAT(/1X,70(1H*)/1H1)
c
      ENDIF
c
CCC     IF(NFILT.NE.0) GOTO 100  ! removal of re-run loop.
C
      RETURN
      END
