PROGRAM c09ccfe

!      C09CCF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. 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 Functions ..
       INTRINSIC                          sum
!      .. Executable Statements ..
       WRITE (nout,*) 'C09CCF Example Program Results'
!      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,99997) nwl
       WRITE (nout,99996)
       WRITE (nout,99995) dwtlev(1:nwl+1)
       nnz = sum(dwtlev(1:nwl+1))
       WRITE (nout,99994)
       WRITE (nout,99998) c(1:nnz)

!      Reconstruct original data
       ny = n

       ifail = 0
       CALL c09cdf(nwl,lenc,c,ny,y,icomm,ifail)

       WRITE (nout,99993)
       WRITE (nout,99998) y(1:ny)

99999  FORMAT (1X,' MLDWT :: Wavelet : ',A10,', End mode : ',A10,' N = ',I10)
99998  FORMAT (8(F8.4,1X):)
99997  FORMAT (1X,' Number of Levels : ',I10)
99996  FORMAT (1X,' Number of coefficients in each level : ')
99995  FORMAT (8(I8,1X):)
99994  FORMAT (1X,' Wavelet coefficients C : ')
99993  FORMAT (1X,' Reconstruction              Y : ')
    END PROGRAM c09ccfe