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