var/external/wavelet/test_filter.F90

   1 ! Author: Aime' Fournier
   2 ! E-mail: fournier@ucar.edu
   3
   4 #include "realt.h"
   5
   6  SUBROUTINE test_filter(nam,ran,kinh,king,h,g)
   7  IMPLICIT NONE
   8  CHARACTER nam                          ! wavelet name
   9  INTEGER k,king,kinh,n,ng,nl,ran
  10  realt, DIMENSION(ran) :: g             ! wavelet hpf
  11  realt, DIMENSION(ran) :: h             ! wavelet lpf
  12  realt :: fg=-1E37,fl=1E37,fs=0.
  13  realt, DIMENSION(:), ALLOCATABLE :: p
  14 !
  15  PRINT '("Filter-convolution ",A1,I2.2,"[",I1,"]*",A1,I2.2,"[",I1,"]:")',&
  16        nam,ran,kinh,nam,ran,king
  17  nl=CEILING(.5*(1-ran))                 ! least n
  18  ng=FLOOR(  .5*(ran-1))                 ! greatest n
  19  ALLOCATE(p(1:ng-nl+1))
  20  p=0.
  21  PRINT '(A,A38,99(I7,:))',CHAR(9),"n:",(n,n=nl,ng)
  22  DO n=nl,ng
  23     DO k=MAX(0,-2*n),MIN(ran-1,ran-1-2*n)
  24        p(n-nl+1)=p(n-nl+1)+h(k+1)*g(k+1+2*n)
  25     ENDDO
  26     IF( n==0 .AND. kinh==king ) p(n-nl+1)=p(n-nl+1)-1.
  27     fl=MIN(fl,p(n-nl+1))
  28     fg=MAX(fg,p(n-nl+1))
  29  ENDDO
  30  PRINT '(A,ES8.1,"<orthogonality error<",ES8.1,":",99(F7.1,:))',CHAR(9),fl,fg,p
  31  DEALLOCATE(p)
  32  END SUBROUTINE test_filter