声振论坛

 找回密码
 我要加入

QQ登录

只需一步,快速开始

查看: 3360|回复: 1

[Fortran] 用切比雪夫最佳一致逼近法设计FIR滤波器

[复制链接]
发表于 2006-8-12 07:34 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?我要加入

x
用切比雪夫最佳一致逼近法设计FIR滤波器,调用子程序remez1。
注意:以上FIR滤波器设计的三个程序中,滤波器的长度应取奇数。

主程序一:
  1. C----------------------------------------------------------------------
  2. c  main program H1DEFIR3: to test subroutine DEFIR3
  3. C  To design FIR low-pass filter by Chebyshev
  4. C                                optimum approximation method.
  5. c  Please link subroutine DEFIR3,REMEZ1,FIRRES,AMPRES,PHARES,UNWRAP
  6. C----------------------------------------------------------------------
  7.         complex h(0:499)
  8.         dimension b(0:32),edge(1:4),fx(1:2),wtx(1:2)
  9.         dimension amp(0:499),phase(0:499)
  10.         data nfilt/32/,nbands/2/,npsd/500/,iamp/1/,fs/1.0/
  11.         data edge(1)/0./,edge(2)/0.3/, edge(3)/0.35/,edge(4)/.5/
  12.         data fx(1)/1.0/,fx(2)/0.0/
  13.         data wtx(1)/1./,wtx(2)/10./
  14.         call defir3(nfilt,nbands,edge,fx,wtx,b)
  15.         open(3,file='h1hdfir3.dat',status='new')
  16.         do 20 k=0,nfilt
  17.            write(3,*)k,b(k)
  18. 20      CONTINUE
  19.         close(3)
  20.         call firres(b,nfilt,npsd,h)
  21.         call ampres(h,amp,npsd,fs,iamp)
  22.         call phares(h,phase,npsd,fs)
  23.         stop
  24.         end
复制代码



主程序二:
  1. C----------------------------------------------------------------------
  2. c  main program H2DEFIR3: to test subroutine DEFIR3
  3. C  To design FIR high-pass  filter by Chebyshev
  4. C                                optimum approximation method.
  5. c  Please link subroutine DEFIR3,REMEZ1,FIRRES,AMPRES,PHARES,UNWRAP
  6. C----------------------------------------------------------------------
  7.         complex h(0:499)
  8.         dimension b(0:32),edge(1:4),fx(1:2),wtx(1:2)
  9.         dimension amp(0:499),phase(0:499)
  10.         data nfilt/32/,nbands/2/,npsd/500/,iamp/1/,fs/1.0/
  11.         data edge(1)/0./,edge(2)/0.3/, edge(3)/0.35/,edge(4)/.5/
  12.         data fx(1)/0.0/,fx(2)/1.0/
  13.         data wtx(1)/1./,wtx(2)/10./
  14.         call defir3(nfilt,nbands,edge,fx,wtx,b)
  15.         open(3,file='h2hdfir3.dat',status='new')
  16.         do 20 k=0,nfilt
  17.            write(3,*)k,b(k)
  18. 20      CONTINUE
  19.         close(3)
  20.         call firres(b,nfilt,npsd,h)
  21.         call ampres(h,amp,npsd,fs,iamp)
  22.         call phares(h,phase,npsd,fs)
  23.         stop
  24.         end
复制代码


主程序三:
  1. C----------------------------------------------------------------------
  2. c  main program H3DEFIR3: to test subroutine DEFIR3
  3. C  To design FIR multi-pass band filter by Chebyshev
  4. C                                optimum approximation method.
  5. c  Please link subroutine DEFIR3,REMEZ1,FIRRES,AMPRES,PHARES,UNWRAP
  6. C----------------------------------------------------------------------
  7.         dimension b(0:64),edge(1:14),fx(1:7),wtx(1:7)
  8.         dimension amp(0:499),phase(0:499)
  9.         complex h(0:499)
  10.         data nfilt/64/,nbands/7/,npsd/500/,iamp/1/,fs/1.0/
  11.         data edge(1)/0./,edge(2)/0.07/, edge(3)/0.09/,edge(4)/.11/
  12.         data edge(5)/0.13/,edge(6)/0.17/, edge(7)/0.19/,edge(8)/.21/
  13.         data edge(9)/0.23/,edge(10)/0.27/, edge(11)/0.29/,edge(12)/.31/
  14.         data edge(13)/0.33/,edge(14)/0.5/
  15.         data fx(1)/0.0/,fx(2)/1.0/,fx(3)/0.0/,fx(4)/1.0/
  16.         data fx(5)/0.0/,fx(6)/1.0/,fx(7)/0.0/
  17.         data wtx(1)/8./,wtx(2)/1./,wtx(3)/8./,wtx(4)/1./
  18.         data wtx(5)/8./,wtx(6)/1./,wtx(7)/8./
  19.         call defir3(nfilt,nbands,edge,fx,wtx,b)
  20.         open(3,file='h3hdfir3.dat',status='new')
  21.         do 20 k=0,nfilt
  22.            write(3,*)k,b(k)
  23. 20      CONTINUE
  24.         close(3)
  25.         call firres(b,nfilt,npsd,h)
  26.         call ampres(h,amp,npsd,fs,iamp)
  27.         call phares(h,phase,npsd,fs)
  28.         stop
  29.         end
复制代码


子程序:
  1.         subroutine defir3(nfilt,nbands,edge,fx,wtx,h)
  2. C----------------------------------------------------------------------
  3. C DEFIR3: To design FIR filter by Weighted Chebyshev Approximation.
  4. c  Input parameters:
  5. c nfilt+1: the length of FIR filter,in this program nfilt<128;
  6. c nbands :Number of bands,in this program nbands<=10;
  7. c fx     :Desired function array for each band,from fx(1) to fx(nbands);
  8. c wtx    :Weight function array in each band,from wtx(1) to wtx(nbands);
  9. c edge   :Bandedge array,lower and upper freq. for each band,from
  10. c          edge(1) to edge(2*nbands);
  11. c  Output parameters:
  12. c       h: (nfilt+1) dimensioned real array,the impulse response.
  13. c                                       in chapter 8
  14. C----------------------------------------------------------------------
  15.         dimension h(0:nfilt),x(1:66),y(1:66)
  16.         dimension iext(1:66),ad(1:66),alpha(1:66)
  17.         dimension edge(1:20),fx(1:nbands),wtx(1:nbands)
  18.         dimension des(1:1045),grid(1:1045),wt(1:1045)
  19.         common pi2,ad,dev,x,y,grid,des,wt,alpha,iext,nfcns,ngrid
  20.         common /oops/niter
  21.         pi2=8.*atan(1.)
  22.         pi=pi2/2.
  23.         nfmax=128
  24.         lgrid=16
  25.         if(nbands.gt.10)return
  26.         if(nfilt.le.nfmax.and.nfilt.ge.3)goto 115
  27.         return
  28. 115     if(nbands.le.0) nband=1
  29.         jb=2*nbands
  30.         nfilt=nfilt+1
  31.         nodd=nfilt/2
  32.         nodd=nfilt-2*nodd
  33.         nfcns=nfilt/2
  34.         if(nodd.eq.1)nfcns=nfcns+1
  35.         grid(1)=edge(1)
  36.         delf=lgrid*nfcns
  37.         delf=0.5/delf
  38.         if(edge(1).lt.delf) grid(1)=delf
  39.         j=1
  40.         l=1
  41.         lband=1
  42. 140     fup=edge(l+1)
  43. 145     temp=grid(j)
  44.         des(j)=fx(lband)
  45.         wt(j)=wtx(lband)
  46.         j=j+1
  47.         grid(j)=temp+delf
  48.         if(grid(j).gt.fup)goto 150
  49.         goto 145
  50. 150     grid(j-1)=fup
  51.         des(j-1)=fx(lband)
  52.         wt(j-1)=wtx(lband)
  53.         lband=lband+1
  54.         l=l+2
  55.         if(lband.gt.nbands) goto 160
  56.         grid(j)=edge(l)
  57.         goto 140
  58. 160     ngrid=j-1
  59.         if(nodd.ne.0)goto 165
  60.         if(grid(ngrid).gt.(.5-delf))ngrid=ngrid-1
  61. 165     continue
  62. c
  63.         if(nodd.eq.1)goto 200
  64.         do 175 j=1,ngrid
  65.            change=cos(pi*grid(j))
  66.            des(j)=des(j)/change
  67.            wt(j)=wt(j)*change
  68. 175     continue
  69. 200     continue
  70.         temp=float(ngrid-1)/float(nfcns)
  71.         do 210 j=1,nfcns
  72.            xt=j-1
  73.            iext(j)=xt*temp+1.
  74. 210     continue
  75.         iext(nfcns+1)=ngrid
  76.         nm1=nfcns-1
  77.         nz=nfcns+1
  78. c----------------------------------------------------------------------
  79.         call remez1
  80. c----------------------------------------------------------------------
  81.         if(nodd.eq.0)goto 310
  82.         do 305 j=0,nm1-1
  83.            nzmj=nfcns-j
  84.            h(j)=.5*alpha(nzmj)
  85.            h(nfilt-j-1)=h(j)
  86. 305     continue
  87.         h(nm1)=alpha(1)
  88.         goto 350
  89. 310     h(0)=.25*alpha(nfcns)
  90.         h(nfilt-1)=h(0)
  91.         do 315 j=1,nm1-1
  92.            nzmj=nfcns-j
  93.            nf2j=nz-j
  94.            h(j)=.25*(alpha(nzmj)+alpha(nf2j))
  95.            h(nfilt-j-1)=h(j)
  96. 315     continue
  97.         h(nm1)=.5*alpha(1)+.25*alpha(2)
  98.         h(nfcns)=h(nm1)
  99. 350     continue
  100.         write(*,*)'                         Deviation   Deviation(db)'
  101.         do 370 j=1,nbands
  102.            a=dev/wtx(j)
  103.            write(*,*)' Band',j,'     ',a,20.*alog10(a+fx(j))
  104. 370     continue
  105.         nfilt=nfilt-1
  106.            return
  107.            end
复制代码
回复
分享到:

使用道具 举报

发表于 2006-9-13 21:21 | 显示全部楼层

请教

“Please link subroutine DEFIR3,REMEZ1,FIRRES,AMPRES,PHARES,UNWRAP”
但是,这几个子程序在哪里呀?
您需要登录后才可以回帖 登录 | 我要加入

本版积分规则

QQ|小黑屋|Archiver|手机版|联系我们|声振论坛

GMT+8, 2024-11-11 00:17 , Processed in 0.063040 second(s), 18 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表