82 lines
2.6 KiB
Fortran
82 lines
2.6 KiB
Fortran
|
|
|||
|
|
SUBROUTINE SUB_WAVELET(n,&
|
|||
|
|
x,&
|
|||
|
|
xden)&
|
|||
|
|
bind(C, name="SUB_WAVELET")
|
|||
|
|
!DEC$ ATTRIBUTES DLLEXPORT::SUB_WAVELET
|
|||
|
|
implicit none
|
|||
|
|
|
|||
|
|
integer :: n
|
|||
|
|
real*8 :: x(n),xden(n)
|
|||
|
|
|
|||
|
|
integer :: level,sz,temp,num,temp_n,p,s,i
|
|||
|
|
real*8 :: Lo_D(8),Hi_D(8),Lo_R(8),Hi_R(8),a(1000),d(1000),temp_xfinal(1000),normfac
|
|||
|
|
real*8,allocatable :: origcfs(:,:),cd(:,:)
|
|||
|
|
integer,allocatable :: temp_sx(:)
|
|||
|
|
real*8 :: temp_x(1000),temp_x2(1000),median,vscale
|
|||
|
|
|
|||
|
|
xden = 0
|
|||
|
|
|
|||
|
|
level = int(log(n/7.0)/log(2.0))
|
|||
|
|
Lo_D = [-0.0757657147892733,-0.0296355276459985,0.497618667632015,0.803738751805916,0.297857795605277,-0.0992195435768472,-0.0126039672620378,0.0322231006040427]
|
|||
|
|
Hi_D = [-0.0322231006040427,-0.0126039672620378,0.0992195435768472,0.297857795605277,-0.803738751805916,0.497618667632015,0.0296355276459985,-0.0757657147892733]
|
|||
|
|
Lo_R = [0.0322231006040427,-0.0126039672620378,-0.0992195435768472,0.297857795605277,0.803738751805916,0.497618667632015,-0.0296355276459985,-0.0757657147892733]
|
|||
|
|
Hi_R = [-0.0757657147892733,0.0296355276459985,0.497618667632015,-0.803738751805916,0.297857795605277,0.0992195435768472,-0.0126039672620378,-0.0322231006040427]
|
|||
|
|
|
|||
|
|
call dwtLOC(n,x,Lo_D,Hi_D,0,2,a,d,sz)
|
|||
|
|
allocate(origcfs(1000,level+1),temp_sx(level+2))
|
|||
|
|
temp_xfinal = 0
|
|||
|
|
origcfs = 0
|
|||
|
|
temp_sx = 0
|
|||
|
|
temp_sx(1) = n !<21><>n-1<><31><EFBFBD><EFBFBD><EFBFBD><EFBFBD>origcfs<66><73><EFBFBD><EFBFBD><EFBFBD>ݸ<EFBFBD><DDB8><EFBFBD>
|
|||
|
|
|
|||
|
|
do i=level+1,2,-1
|
|||
|
|
if(i==level+1) then
|
|||
|
|
call dwtLOC(n,x,Lo_D,Hi_D,0,2,a,d,sz)
|
|||
|
|
temp_xfinal = 0
|
|||
|
|
temp_xfinal(1:sz) = a(1:sz)
|
|||
|
|
else
|
|||
|
|
call dwtLOC(sz,temp_xfinal,Lo_D,Hi_D,0,2,a,d,temp)
|
|||
|
|
temp_xfinal = 0
|
|||
|
|
sz = temp
|
|||
|
|
temp_xfinal(1:sz) = a(1:sz)
|
|||
|
|
end if
|
|||
|
|
origcfs(1:sz,level+2-i) = d(1:sz)
|
|||
|
|
temp_sx(level+2-i+1) = sz
|
|||
|
|
if(i==2) temp_sx(level+2) = sz
|
|||
|
|
end do
|
|||
|
|
origcfs(1:sz,level+1) = temp_xfinal(1:sz)
|
|||
|
|
|
|||
|
|
normfac = 1.48260221850560
|
|||
|
|
vscale = normfac*median(temp_sx(2),abs(origcfs(1:temp_sx(2),1)))
|
|||
|
|
|
|||
|
|
allocate(cd(1000,level))
|
|||
|
|
cd = 0
|
|||
|
|
do i=1,level
|
|||
|
|
call ebayesthresh(temp_sx(i+1),origcfs(1:temp_sx(i+1),i),vscale,cd(1:temp_sx(i+1),i))
|
|||
|
|
end do
|
|||
|
|
|
|||
|
|
temp_x = origcfs(:,level+1)
|
|||
|
|
temp_n = temp_sx(level+2)
|
|||
|
|
do i=level,1,-1
|
|||
|
|
p = level+2-i
|
|||
|
|
s = temp_sx(level+2-p)
|
|||
|
|
call upsconv(temp_n,temp_x,Lo_R,s,temp_x2)
|
|||
|
|
call upsconv(temp_sx(i+1),cd(1:temp_sx(i+1),i),Hi_R,s,temp_x)
|
|||
|
|
temp_x = temp_x+temp_x2
|
|||
|
|
temp_n = s
|
|||
|
|
end do
|
|||
|
|
|
|||
|
|
xden = temp_x(1:n)
|
|||
|
|
|
|||
|
|
end subroutine
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|
|||
|
|
|