65 lines
1.3 KiB
Fortran
65 lines
1.3 KiB
Fortran
|
|
||
|
|
SUBROUTINE dwtLOC(n,x,LoD,HiD,perFLAG,first,a,d,sz)
|
||
|
|
implicit none
|
||
|
|
|
||
|
|
integer :: n,perFLAG,first,sz
|
||
|
|
real*8 :: x(n),LoD(8),HiD(8),a(1000),d(1000)
|
||
|
|
|
||
|
|
integer :: dCol,lenEXT,lenKEPT,i,j
|
||
|
|
integer,allocatable :: idxCOL(:)
|
||
|
|
real*8,allocatable :: y(:),c1(:),c2(:)
|
||
|
|
|
||
|
|
a = 0
|
||
|
|
d = 0
|
||
|
|
sz = 0
|
||
|
|
|
||
|
|
dCol = 7
|
||
|
|
if(perFLAG==0) then
|
||
|
|
lenEXT = 7
|
||
|
|
lenKEPT = n+7
|
||
|
|
else
|
||
|
|
lenEXT = 4
|
||
|
|
lenKEPT = 2*int(ceiling(n/2.0))
|
||
|
|
end if
|
||
|
|
|
||
|
|
sz = int(lenKEPT/2.0)
|
||
|
|
allocate(idxCOL(sz))
|
||
|
|
do i=1,sz
|
||
|
|
idxCOL(i) = first+dCol+2*(i-1)
|
||
|
|
end do
|
||
|
|
|
||
|
|
allocate(y(n+2*lenEXT))
|
||
|
|
y(1:lenEXT) = x(lenEXT:-1:1)
|
||
|
|
do i=1,lenEXT
|
||
|
|
y(i) = x(lenEXT+1-i)
|
||
|
|
end do
|
||
|
|
do i=lenEXT+1,lenEXT+n
|
||
|
|
y(i) = x(i-lenEXT)
|
||
|
|
end do
|
||
|
|
do i=lenEXT+n+1,n+2*lenEXT
|
||
|
|
y(i) = x(2*n+lenEXT+1-i)
|
||
|
|
end do
|
||
|
|
|
||
|
|
!y(lenEXT+1:lenEXT+n) = x
|
||
|
|
!y(lenEXT+n+1:n+2*lenEXT) = x(n:-1:n-lenEXT+1)
|
||
|
|
|
||
|
|
allocate(c1(n+2*lenEXT+7),c2(n+2*lenEXT+7))
|
||
|
|
c1 = 0
|
||
|
|
c2 = 0
|
||
|
|
do i=1,n+2*lenEXT
|
||
|
|
do j = 1,8
|
||
|
|
c1(i+j-1) = c1(i+j-1)+y(i)*LoD(j)
|
||
|
|
c2(i+j-1) = c2(i+j-1)+y(i)*HiD(j)
|
||
|
|
end do
|
||
|
|
end do
|
||
|
|
|
||
|
|
do i=1,sz
|
||
|
|
a(i) = c1(idxCOL(i))
|
||
|
|
d(i) = c2(idxCOL(i))
|
||
|
|
end do
|
||
|
|
|
||
|
|
end subroutine
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|