4
This commit is contained in:
parent
8cfa32cc86
commit
dd0c106761
@ -1,132 +0,0 @@
|
||||
|
||||
SUBROUTINE appcoef(nc,c,nl,l,n,IN3,na,a)
|
||||
implicit none
|
||||
|
||||
integer :: nc,nl,n,na
|
||||
real*8 :: c(nc),a(1000)
|
||||
integer :: l(nl)
|
||||
character(len=3) :: IN3
|
||||
|
||||
integer :: rmax,nmax,nd,imax,lf,i
|
||||
real*8 :: d(1000)
|
||||
real*8,allocatable :: Lo_D(:),Hi_D(:),tempa(:)
|
||||
|
||||
rmax = nl
|
||||
nmax = rmax-2
|
||||
|
||||
na = 0
|
||||
a = 0
|
||||
|
||||
select case(IN3)
|
||||
case('db2')
|
||||
lf = 4
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.482962913144690,0.836516303737469,0.224143868041857,-0.129409522550921]
|
||||
Hi_D = [-0.129409522550921,-0.224143868041857,0.836516303737469,-0.482962913144690]
|
||||
|
||||
case('db3')
|
||||
lf = 6
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.332670552950957,0.806891509313339,0.459877502119331,&
|
||||
-0.135011020010391,-0.0854412738822415,0.0352262918821007]
|
||||
Hi_D = [0.0352262918821007,0.0854412738822415,-0.135011020010391,&
|
||||
-0.459877502119331,0.806891509313339,-0.332670552950957]
|
||||
|
||||
case('db4')
|
||||
lf = 8
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.230377813308855,0.714846570552542,0.630880767929590,-0.0279837694169839,&
|
||||
-0.187034811718881,0.0308413818359870,0.0328830116669829,-0.0105974017849973]
|
||||
Hi_D = [-0.0105974017849973,-0.0328830116669829,0.0308413818359870,0.187034811718881,&
|
||||
-0.0279837694169839,-0.630880767929590,0.714846570552542,-0.230377813308855]
|
||||
|
||||
case('db5')
|
||||
lf = 10
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.160102397974125,0.603829269797473,0.724308528438574,0.138428145901103,&
|
||||
-0.242294887066190,-0.0322448695850295,0.0775714938400652,&
|
||||
-0.00624149021301171,-0.0125807519990155,0.00333572528500155]
|
||||
Hi_D = [0.00333572528500155,0.0125807519990155,-0.00624149021301171,&
|
||||
-0.0775714938400652,-0.0322448695850295,0.242294887066190,0.138428145901103,&
|
||||
-0.724308528438574,0.603829269797473,-0.160102397974125]
|
||||
|
||||
case('db6')
|
||||
lf = 12
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.111540743350080,0.494623890398385,0.751133908021578,0.315250351709243,&
|
||||
-0.226264693965169,-0.129766867567096,0.0975016055870794,0.0275228655300163,&
|
||||
-0.0315820393180312,0.000553842200993802,0.00477725751101065,-0.00107730108499558]
|
||||
Hi_D = [-0.00107730108499558,&
|
||||
-0.00477725751101065,0.000553842200993802,0.0315820393180312,0.0275228655300163,&
|
||||
-0.0975016055870794,&
|
||||
-0.129766867567096,0.226264693965169,0.315250351709243,&
|
||||
-0.751133908021578,0.494623890398385,-0.111540743350080]
|
||||
|
||||
case('db7')
|
||||
lf = 14
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.0778520540850624,0.396539319482306,0.729132090846555,0.469782287405359,&
|
||||
-0.143906003929106,&
|
||||
-0.224036184994166,0.0713092192670500,0.0806126091510659,-0.0380299369350346,&
|
||||
-0.0165745416310156,0.0125509985560138,0.000429577973004703,&
|
||||
-0.00180164070399983,0.000353713800001040]
|
||||
Hi_D = [0.000353713800001040,0.00180164070399983,0.000429577973004703,-0.0125509985560138,&
|
||||
-0.0165745416310156,0.0380299369350346,0.0806126091510659,-0.0713092192670500,&
|
||||
-0.224036184994166,0.143906003929106,0.469782287405359,&
|
||||
-0.729132090846555,0.396539319482306,-0.0778520540850624]
|
||||
|
||||
case('db8')
|
||||
lf = 16
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.0544158422430816,0.312871590914466,0.675630736298013,0.585354683654869,&
|
||||
-0.0158291052560239,&
|
||||
-0.284015542962428,0.000472484573997973,0.128747426620186,-0.0173693010020221,&
|
||||
-0.0440882539310647,0.0139810279170155,0.00874609404701566,&
|
||||
-0.00487035299301066,-0.000391740372995977,0.000675449405998557,-0.000117476784002282]
|
||||
Hi_D = [-0.000117476784002282,-0.000675449405998557,&
|
||||
-0.000391740372995977,0.00487035299301066,0.00874609404701566,-0.0139810279170155,&
|
||||
-0.0440882539310647,0.0173693010020221,0.128747426620186,-0.000472484573997973,&
|
||||
-0.284015542962428,0.0158291052560239,0.585354683654869,&
|
||||
-0.675630736298013,0.312871590914466,-0.0544158422430816]
|
||||
|
||||
case('fk4')
|
||||
lf = 4
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.653927555569765,0.753272492839488,0.0531792287790598,-0.0461657148152177]
|
||||
Hi_D = [-0.0461657148152177,-0.0531792287790598,0.753272492839488,-0.653927555569765]
|
||||
|
||||
case('fk6')
|
||||
lf = 6
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.427915032422310,0.812919643136907,0.356369511070187,&
|
||||
-0.146438681272577,-0.0771777574069701,0.0406258144232379]
|
||||
Hi_D = [0.0406258144232379,0.0771777574069701,-0.146438681272577,&
|
||||
-0.356369511070187,0.812919643136907,-0.427915032422310]
|
||||
|
||||
case('fk8')
|
||||
lf = 8
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.349238111863800,0.782683620384065,0.475265135079471,-0.0996833284505732,&
|
||||
-0.159978097434030,0.0431066681065162,0.0425816316775818,-0.0190001788537359]
|
||||
Hi_D = [-0.0190001788537359,-0.0425816316775818,0.0431066681065162,0.159978097434030,&
|
||||
-0.0996833284505732,-0.475265135079471,0.782683620384065,-0.349238111863800]
|
||||
|
||||
end select
|
||||
|
||||
na = l(1)
|
||||
a(1:na) = c(1:na)
|
||||
|
||||
imax = rmax+1
|
||||
do i=nmax,n+1,-1
|
||||
call detcoef(nc,c,nl,l,i,nd,d)
|
||||
|
||||
allocate(tempa(l(imax-i)))
|
||||
call idwt(na,a,nd,d,lf,Lo_D,Hi_D,l(imax-i),tempa)
|
||||
na = l(imax-i)
|
||||
a(1:na) = tempa
|
||||
|
||||
deallocate(tempa)
|
||||
end do
|
||||
|
||||
deallocate(Lo_D,Hi_D)
|
||||
end subroutine
|
||||
@ -1,145 +0,0 @@
|
||||
|
||||
SUBROUTINE wavedec(s,x,n,IN3,nc,c,nl,l)
|
||||
implicit none
|
||||
|
||||
integer :: s,n,nc,nl
|
||||
integer :: l(nl)
|
||||
real*8 :: x(s),c(1000)
|
||||
character(len=3) :: IN3
|
||||
real*8,allocatable :: Lo_D(:),Hi_D(:),y(:),a(:),d(:),z(:),temp(:)
|
||||
integer :: lf,i,first,last,lenEXT,ny,nz,num,j,tempn
|
||||
|
||||
c = 0
|
||||
l = 0
|
||||
|
||||
select case(IN3)
|
||||
case('db2')
|
||||
lf = 4
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [-0.129409522550921,0.224143868041857,0.836516303737469,0.482962913144690]
|
||||
Hi_D = [-0.482962913144690,0.836516303737469,-0.224143868041857,-0.129409522550921]
|
||||
|
||||
case('db3')
|
||||
lf = 6
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.0352262918821007,-0.0854412738822415,-0.135011020010391,0.459877502119331,0.806891509313339,0.332670552950957]
|
||||
Hi_D = [-0.332670552950957,0.806891509313339,-0.459877502119331,-0.135011020010391,0.0854412738822415,0.0352262918821007]
|
||||
|
||||
case('db4')
|
||||
lf = 8
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [-0.0105974017849973,0.0328830116669829,0.0308413818359870,-0.187034811718881,&
|
||||
-0.0279837694169839,0.630880767929590,0.714846570552542,0.230377813308855]
|
||||
Hi_D = [-0.230377813308855,0.714846570552542,-0.630880767929590,-0.0279837694169839,0.187034811718881,0.0308413818359870,&
|
||||
-0.0328830116669829,-0.0105974017849973]
|
||||
|
||||
case('db5')
|
||||
lf = 10
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.00333572528500155,-0.0125807519990155,-0.00624149021301171,0.0775714938400652,-0.0322448695850295,&
|
||||
-0.242294887066190,0.138428145901103,0.724308528438574,0.603829269797473,0.160102397974125]
|
||||
Hi_D = [-0.160102397974125,0.603829269797473,-0.724308528438574,0.138428145901103,0.242294887066190,-0.0322448695850295,&
|
||||
-0.0775714938400652,-0.00624149021301171,0.0125807519990155,0.00333572528500155]
|
||||
|
||||
case('db6')
|
||||
lf = 12
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [-0.00107730108499558,0.00477725751101065,0.000553842200993802,&
|
||||
-0.0315820393180312,0.0275228655300163,0.0975016055870794,&
|
||||
-0.129766867567096,-0.226264693965169,0.315250351709243,0.751133908021578,0.494623890398385,0.111540743350080]
|
||||
Hi_D = [-0.111540743350080,0.494623890398385,-0.751133908021578,0.315250351709243,0.226264693965169,-0.129766867567096,&
|
||||
-0.0975016055870794,0.0275228655300163,0.0315820393180312,0.000553842200993802,&
|
||||
-0.00477725751101065,-0.00107730108499558]
|
||||
|
||||
case('db7')
|
||||
lf = 14
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.000353713800001040,-0.00180164070399983,0.000429577973004703,0.0125509985560138,-0.0165745416310156,&
|
||||
-0.0380299369350346,0.0806126091510659,0.0713092192670500,-0.224036184994166,&
|
||||
-0.143906003929106,0.469782287405359,0.729132090846555,0.396539319482306,0.0778520540850624]
|
||||
Hi_D = [-0.0778520540850624,0.396539319482306,-0.729132090846555,0.469782287405359,0.143906003929106,&
|
||||
-0.224036184994166,-0.0713092192670500,0.0806126091510659,0.0380299369350346,-0.0165745416310156,&
|
||||
-0.0125509985560138,0.000429577973004703,0.00180164070399983,0.000353713800001040]
|
||||
|
||||
case('db8')
|
||||
lf = 16
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [-0.000117476784002282,0.000675449405998557,-0.000391740372995977,&
|
||||
-0.00487035299301066,0.00874609404701566,0.0139810279170155,&
|
||||
-0.0440882539310647,-0.0173693010020221,0.128747426620186,0.000472484573997973,&
|
||||
-0.284015542962428,-0.0158291052560239,0.585354683654869,0.675630736298013,0.312871590914466,0.0544158422430816]
|
||||
Hi_D = [-0.0544158422430816,0.312871590914466,-0.675630736298013,0.585354683654869,0.0158291052560239,-0.284015542962428,&
|
||||
-0.000472484573997973,0.128747426620186,0.0173693010020221,-0.0440882539310647,&
|
||||
-0.0139810279170155,0.00874609404701566,0.00487035299301066,-0.000391740372995977,&
|
||||
-0.000675449405998557,-0.000117476784002282]
|
||||
|
||||
case('fk4')
|
||||
lf = 4
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [-0.0461657148152177,0.0531792287790598,0.753272492839488,0.653927555569765]
|
||||
Hi_D = [-0.653927555569765,0.753272492839488,-0.0531792287790598,-0.0461657148152177]
|
||||
|
||||
case('fk6')
|
||||
lf = 6
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [0.0406258144232379,-0.0771777574069701,-0.146438681272577,0.356369511070187,0.812919643136907,0.427915032422310]
|
||||
Hi_D = [-0.427915032422310,0.812919643136907,-0.356369511070187,-0.146438681272577,0.0771777574069701,0.0406258144232379]
|
||||
|
||||
case('fk8')
|
||||
lf = 8
|
||||
allocate(Lo_D(lf),Hi_D(lf))
|
||||
Lo_D = [-0.0190001788537359,0.0425816316775818,0.0431066681065162,-0.159978097434030,&
|
||||
-0.0996833284505732,0.475265135079471,0.782683620384065,0.349238111863800]
|
||||
Hi_D = [-0.349238111863800,0.782683620384065,-0.475265135079471,-0.0996833284505732,0.159978097434030,0.0431066681065162,&
|
||||
-0.0425816316775818,-0.0190001788537359]
|
||||
|
||||
end select
|
||||
|
||||
l(n+2) = s
|
||||
nc = 0
|
||||
tempn = s
|
||||
allocate(temp(tempn))
|
||||
temp = x
|
||||
do i=1,n
|
||||
first = 2
|
||||
lenEXT = lf-1
|
||||
last = tempn+lf-1
|
||||
ny = tempn+2*lenEXT
|
||||
nz = ny-lf+1
|
||||
allocate(y(ny),z(nz))
|
||||
call wextend(tempn,temp,lenEXT,y)
|
||||
|
||||
call conv_valid(ny,y,lf,Lo_D,z)
|
||||
num = (last-first)/2+1
|
||||
allocate(a(num),d(num))
|
||||
do j=1,num
|
||||
a(j) = z(first+(j-1)*2)
|
||||
end do
|
||||
|
||||
call conv_valid(ny,y,lf,Hi_D,z)
|
||||
do j=1,num
|
||||
d(j) = z(first+(j-1)*2)
|
||||
end do
|
||||
|
||||
nc = num+nc
|
||||
c(num+1:nc) = c(1:nc)
|
||||
c(1:num) = d(1:num)
|
||||
l(n+2-i) = num
|
||||
|
||||
deallocate(temp)
|
||||
tempn = num
|
||||
allocate(temp(tempn))
|
||||
temp = a
|
||||
|
||||
deallocate(a,y,z,d)
|
||||
end do
|
||||
|
||||
nc = num+nc
|
||||
c(num+1:nc) = c(1:nc)
|
||||
c(1:num) = temp
|
||||
l(1) = num
|
||||
|
||||
deallocate(temp,Lo_D,Hi_D)
|
||||
end subroutine
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user