Program c09aafe ! C09AAF Example Program Text ! Mark 24 Release. NAG Copyright 2012. ! .. Use Statements .. Use nag_library, Only: c09aaf, c09ccf, c09cdf, nag_wp ! .. Implicit None Statement .. Implicit None ! .. Parameters .. Integer, Parameter :: nin = 5, nout = 6 ! .. Local Scalars .. Integer :: ifail, lenc, n, nf, nnz, nwc, nwl, ny Character (10) :: mode, wavnam, wtrans ! .. Local Arrays .. Real (Kind=nag_wp), Allocatable :: c(:), x(:), y(:) Integer, Allocatable :: dwtlev(:) Integer :: icomm(100) ! .. Intrinsic Procedures .. Intrinsic :: sum ! .. Executable Statements .. Write (nout,*) 'C09AAF Example Program Results' Write (nout,*) ! Skip heading in data file Read (nin,*) ! Read problem parameters Read (nin,*) n Read (nin,*) wavnam, mode Allocate (x(n),y(n)) Write (nout,99999) wavnam, mode, n ! Read data array and write it out Read (nin,*) x(1:n) Write (nout,*) ' Input Data X :' Write (nout,99998) x(1:n) ! Query wavelet filter dimensions ! For Multi-Resolution Analysis, decomposition, wtrans = 'M' wtrans = 'Multilevel' ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 Call c09aaf(wavnam,wtrans,mode,n,nwl,nf,nwc,icomm,ifail) lenc = nwc Allocate (c(lenc),dwtlev(nwl+1)) ! Perform Discrete Wavelet transform ifail = 0 Call c09ccf(n,x,lenc,c,nwl,dwtlev,icomm,ifail) Write (nout,*) Write (nout,99997) nf Write (nout,99996) nwl Write (nout,99995) Write (nout,99994) dwtlev(1:nwl+1) Write (nout,99993) nwc nnz = sum(dwtlev(1:nwl+1)) Write (nout,*) Write (nout,99992) Write (nout,99998) c(1:nnz) ! Reconstruct original data ny = n ifail = 0 Call c09cdf(nwl,lenc,c,ny,y,icomm,ifail) Write (nout,*) Write (nout,99991) Write (nout,99998) y(1:ny) 99999 Format (1X,' Parameters read from file :: '/' Wavelet : ',A10, & ' End mode : ',A10,' N = ',I10) 99998 Format (8(F8.3,1X):) 99997 Format (1X,' Length of wavelet filter : ',I10) 99996 Format (1X,' Number of Levels : ',I10) 99995 Format (1X,' Number of coefficients in each level : ') 99994 Format (16X,8(I8,1X):) 99993 Format (1X,' Total number of wavelet coefficients : ',I10) 99992 Format (1X,' Wavelet coefficients C : ') 99991 Format (1X,' Reconstruction Y : ') End Program c09aafe