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 !şón-1¸öĘýĘÇorigcfsľÄĘýžÝ¸öĘý
|
||
|
||
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
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|